{******************************************************************}
{ AboutDlg.pas                                                     }
{                                                                  }
{ Author    : A.Nasir Senturk                                      }
{ Home Page : http://www.shenturk.com                              }
{ Email     : shenturk@gmail.com                                   }
{                                                                  }
{ Date      : 28.12.2006                                           }
{ Update    : 22.03.2007                                           }
{                                                                  }
{ Sizden iki şey rica edicem:                                      }
{ 1. Lutfen bu baslik kismini kaldirmayiniz.                       }
{ 2. Mumkunse bagis yapiniz.                                       }
{ *****************************************************************}

unit AboutDlg;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, GdipApi, GdipObj, DirectDraw, TextUtil;

type
  TAboutForm = class(TForm)
    BackgrndLbl: TLabel;
    CloseBtn: TButton;
    HeaderTextLbl: TLabel;
    LogoImageLbl: TLabel;
    ProductNameLbl: TLabel;
    Label1: TLabel;
    Label2: TLabel;
    Label3: TLabel;
    Label5: TLabel;
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure FormMouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure CloseBtnClick(Sender: TObject);
    procedure Label2Click(Sender: TObject);
    procedure Label2MouseEnter(Sender: TObject);
    procedure Label2MouseLeave(Sender: TObject);
  private
    { Private declarations }
    OpacityMin,
    OpacityMax,
    Opacity: Byte;
    MainBuffer: TGPBitmap;
    DrawCanvas: TGPGraphics;

    ColorizedImage,
    CloseImage,
    OverlayImage,
    LogoImage: TGPBitmap;

    //BackScale: Single;
    BackColor: Cardinal;
    BackOpacity: Byte;

    procedure AllocateHandle;
    procedure ReleaseHandle;
    procedure SetFormStyleEx;

  public
    ScaleWidth,
    ScaleHeight: Single;
    WebLinkColor: TGPColor;
    { Public declarations }
    procedure UpdateLayered;
    procedure UpdateMainWindow;
    procedure PaintBackground;
    procedure PaintButtons;
    procedure HideForm;
    procedure ShowForm;
    procedure FadeInEffect(const Step, Wait, Max: Integer);
    procedure FadeOutEffect(const Step, Wait, Min: Integer);
    procedure PaintHeaderText;
    procedure PaintLogoImage;
    procedure PaintProductName;
  end;

var
  AboutForm: TAboutForm;

implementation

uses Main, ConstDef, ShelApix;

{$R *.dfm}

{ TAboutForm }

procedure TAboutForm.AllocateHandle;
begin
  MainBuffer := TGPBitmap.Create(Width, Height, PixelFormat32bppARGB);
  DrawCanvas := TGPGraphics.Create(MainBuffer);
end;

procedure TAboutForm.FadeInEffect(const Step, Wait, Max: Integer);
begin
  if not EyMainForm.EnableFadeEffect then Exit;
  while Opacity < Max do
  begin
    Application.ProcessMessages;
    if Opacity + Step >= Max then
    begin
      Opacity := Max;
      UpdateMainWindow;
      Break;
    end;
    Opacity := Opacity + Step;
    UpdateMainWindow;
    Sleep(Wait);
  end;
end;

procedure TAboutForm.FadeOutEffect(const Step, Wait, Min: Integer);
begin
  if not EyMainForm.EnableFadeEffect then Exit;
  while Opacity > Min do
  begin
    Application.ProcessMessages;
    if Opacity - Step <= Min then
    begin
      Opacity := Min;
      UpdateMainWindow;
      Break;
    end;
    Opacity := Opacity - Step;
    UpdateMainWindow;
    Sleep(Wait);
  end;
end;

procedure TAboutForm.HideForm;
begin
  if not Self.Visible then Exit;
  if EyMainForm.EnableFadeEffect then
    FadeOutEffect(DefOpacityStep, DefOpacityWait, OpacityMin)
  else begin
    Opacity := OpacityMin;
    UpdateMainWindow;
  end;
  Self.Hide;
end;

procedure TAboutForm.PaintBackground;

  procedure PaintColorizedOverlay;
  begin
    {
    DrawCanvas.DrawImage(OverlayImage,
      BackgrndLbl.Left + 6,
      BackgrndLbl.Top + 3,
      OverlayImage.GetWidth, OverlayImage.GetHeight);
    }
    DrawCanvas.DrawImage(OverlayImage,
      BackgrndLbl.Left + (7 * ScaleWidth) - ScaleWidth,
      BackgrndLbl.Top + (4 * ScaleHeight) - ScaleHeight + 0.15,
      OverlayImage.GetWidth * ScaleWidth,
      OverlayImage.GetHeight * ScaleHeight);
  end;

  procedure PaintColorized(Color: Cardinal; Alpha: Byte);
  const
    CMatrix: ColorMatrix = (
      (1.0, 0.0, 0.0, 0.0, 1.0),
      (0.0, 1.0, 0.0, 0.0, 0.0),
      (0.0, 0.0, 1.0, 0.0, 0.0),
      (0.0, 0.0, 0.0, 1.0, 0.0),
      (0.0, 0.0, 0.0, 0.0, 1.0)
    );
  var
    Attr: TGPImageAttributes;
    Matrix: ColorMatrix;
  begin

    Matrix := CMatrix;

    Matrix[3, 3] := (Alpha / 255);
    Matrix[0, 0] := 2 * (GetRValue(Color) / 255);
    Matrix[1, 1] := 2 * (GetGValue(Color) / 255);
    Matrix[2, 2] := 2 * (GetBValue(Color) / 255);

    Attr := TGPImageAttributes.Create;
    try
      Attr.SetColorMatrix(Matrix, ColorMatrixFlagsDefault, ColorAdjustTypeBitmap);

      DrawCanvas.DrawImage(ColorizedImage,
        MakeRect(BackgrndLbl.Left, BackgrndLbl.Top,
        ColorizedImage.GetWidth * ScaleWidth,
        ColorizedImage.GetHeight * ScaleHeight),  // dest rect
        0, 0, ColorizedImage.GetWidth, ColorizedImage.GetHeight,       // source rect
        UnitPixel,
        Attr);

      PaintColorizedOverlay;

    finally
      Attr.Free;
    end;

  end;

begin
  if BackgrndLbl.Visible then
    PaintColorized(BackColor, BackOpacity);
end;

procedure TAboutForm.PaintButtons;
begin
  if CloseBtn.Enabled then begin
    if CloseBtn.Visible then
      DrawCanvas.DrawImage(CloseImage, CloseBtn.Left, CloseBtn.Top,
        CloseImage.GetWidth, CloseImage.GetHeight);
  end;
end;

procedure TAboutForm.PaintHeaderText;
var
  oRect, R: TGPRectF;
  WideText: WideString;
begin
  if HeaderTextLbl.Visible then
  begin

    WideText := 'Ey DSL! Hakkında...';

    if WideText <> '' then
    begin
      GdiPlusMeasureString(DrawCanvas, WideText, oRect, HeaderTextLbl.Font,
        StringAlignmentCenter);

      HeaderTextLbl.ClientWidth := Round(oRect.Width) + 1;
      HeaderTextLbl.ClientHeight := Round(oRect.Height) + 1;

      R := MakeRectF(HeaderTextLbl.BoundsRect);

      OffsetRectF(R, -1.0, -1.0);
      GdiPlusDrawText(DrawCanvas, WideText, R, HeaderTextLbl.Font,
        StringAlignmentCenter, aclWhite);

    end;
  end;
end;

procedure TAboutForm.ReleaseHandle;
begin
  if Assigned(MainBuffer) then FreeAndNil(MainBuffer);
  if Assigned(DrawCanvas) then FreeAndNil(DrawCanvas);
end;

procedure TAboutForm.ShowForm;
begin
  //LoadOptions;
  BackColor := IniFile.ReadInteger(sGeneral, sBackColor, Integer($00C08000));
  //BackColor := $00000000;
  BackOpacity := IniFile.ReadInteger(sGeneral, sBackOpacity, Integer($E0));
  UpdateLayered;
  if Self.Visible then Exit;
  Self.Show;
  if EyMainForm.EnableFadeEffect then
    FadeInEffect(DefOpacityStep, DefOpacityWait, OpacityMax)
  else begin
    Opacity := OpacityMax;
    UpdateMainWindow;
  end;
  ProductNameLbl.Visible := True;
  Sleep(200);
end;

procedure TAboutForm.UpdateLayered;
begin
  try

    ReleaseHandle;
    AllocateHandle;

    PaintBackground;
    PaintButtons;
    PaintHeaderText;
    PaintLogoImage;
    PaintProductName;
    
    UpdateMainWindow;

  finally

  end;
end;

procedure TAboutForm.UpdateMainWindow;
var
  ScrDC, MemDC: HDC;
  BitmapHandle, PrevBitmap: HBITMAP;
  BlendFunc: _BLENDFUNCTION;
  Size: TSize;
  P, S: TPoint;
begin

  ScrDC := CreateCompatibleDC(0);
  MemDC := CreateCompatibleDC(ScrDC);

  MainBuffer.GetHBITMAP(0, BitmapHandle);
  PrevBitmap := SelectObject(MemDC, BitmapHandle);
  Size.cx := Width;
  Size.cy := Height;
  P := Point(Left, Top);
  S := Point(0, 0);

  with BlendFunc do
  begin
    BlendOp := AC_SRC_OVER;
    BlendFlags := 0;
    SourceConstantAlpha := Opacity;
    AlphaFormat := AC_SRC_ALPHA;
  end;

  UpdateLayeredWindow(Handle, ScrDC, @P, @Size, MemDC, @S, 0,
    @BlendFunc, ULW_ALPHA);

  SelectObject(MemDC, PrevBitmap);
  DeleteObject(BitmapHandle);

  DeleteDC(MemDC);
  DeleteDC(ScrDC);

end;

procedure TAboutForm.FormCreate(Sender: TObject);
begin

  ScaleWidth := 1.32;
  ScaleHeight := 1.00;

  WebLinkColor := $FFFFFF80;

  BackColor := IniFile.ReadInteger(sGeneral, sBackColor, Integer($00C08000));
  //BackColor := $00000000;
  BackOpacity := IniFile.ReadInteger(sGeneral, sBackOpacity, Integer($E0));

  SetFormStyleEx;

  LogoImage := TGPBitmap.Create(UIPath + LogoImageName);
  CloseImage := TGPBitmap.Create(UIPath + CloseLeaveImage);
  ColorizedImage := TGPBitmap.Create(UIPath + Background6Image);
  OverlayImage := TGPBitmap.Create(UIPath + Overlay6Image);

  OpacityMin := DefOpacityMin;
  OpacityMax := DefOpacityMax;

  if EyMainForm.EnableFadeEffect then Opacity := DefOpacityMin
  else Opacity := DefOpacityMax;

  Self.Width := Round(ColorizedImage.GetWidth * ScaleWidth);
  Self.Height := Round(ColorizedImage.GetHeight * ScaleHeight);

  UpdateLayered;

end;

procedure TAboutForm.FormDestroy(Sender: TObject);
begin
  OverlayImage.Free;
  ColorizedImage.Free;
  LogoImage.Free;
  CloseImage.Free;
  ReleaseHandle;
end;

procedure TAboutForm.FormMouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
var
  R: TRect;
begin
  if Button = mbLeft then
  begin
    ReleaseCapture;
    SendMessage( Handle, WM_SYSCOMMAND, SC_DRAGMOVE, 0 );
    GetWindowRect(Handle, R);
    Left := R.Left;
    Top := R.Top;
    //UpdateLayered;
  end;
end;

procedure TAboutForm.CloseBtnClick(Sender: TObject);
begin
  HideForm;
end;

procedure TAboutForm.PaintLogoImage;
begin
  if LogoImageLbl.Visible then
  begin
    if Assigned(DrawCanvas) then
      DrawImageTo(DrawCanvas, LogoImageLbl.Left, LogoImageLbl.Top,
        LogoImage.GetWidth * 0.47,
        LogoImage.GetHeight * 0.47, LogoImage);
  end;
end;

procedure TAboutForm.PaintProductName;
var
  WideText: WideString;
begin
  WideText := 'Ey DSL!';
  PaintLabelTo(DrawCanvas, ProductNameLbl, WideText, StringAlignmentNear, aclWhite,
    True, TextRenderingHintAntiAliasGridFit);
  WideText := '"Kota Ajanı"';
  PaintLabelTo(DrawCanvas, Label5, WideText, StringAlignmentNear, aclWhite,
    True, TextRenderingHintAntiAliasGridFit);
  WideText := 'Sürüm: 1.0'#13#10'Geliştiren: A.Nâsır Şentürk';
  PaintLabelTo(DrawCanvas, Label1, WideText, StringAlignmentNear, aclWhite,
    True, TextRenderingHintAntiAliasGridFit);
  WideText := 'www.shenturk.com';
  PaintLabelTo(DrawCanvas, Label2, WideText, StringAlignmentNear, WebLinkColor,
    True, TextRenderingHintAntiAliasGridFit);
  WideText := 'Ey DSL! Genel Kamu Lisansı (GPL) ile dağıtılmakta olup ' +
    'Açık Kaynak Kodu projesi çerçevesinde eğitim amacıyla üretilmiştir. ' +
    'Sadece kullanıcı bağışları ile gelir elde edilmektedir. ' +
    'Hiçbir şekilde ticari olarak kullanılamaz.';
  PaintLabelTo(DrawCanvas, Label3, WideText, StringAlignmentNear, aclWhite,
    True, TextRenderingHintAntiAliasGridFit);
end;

procedure TAboutForm.Label2Click(Sender: TObject);
begin
  ShellExecute(Self.Handle, 'open', MyHomePageURL + 'projects.html#eydsl',
    nil, nil, SW_SHOWNORMAL);
end;

procedure TAboutForm.SetFormStyleEx;
var
  StyleEx: Cardinal;
begin
  StyleEx := GetWindowLong(Handle, GWL_EXSTYLE);
  if StyleEx and WS_EX_LAYERED = 0 then
    SetWindowLong(Handle, GWL_EXSTYLE, StyleEx or WS_EX_LAYERED);
end;

procedure TAboutForm.Label2MouseEnter(Sender: TObject);
begin
  WebLinkColor := $FF60DCFF;
  UpdateLayered;
end;

procedure TAboutForm.Label2MouseLeave(Sender: TObject);
begin
  WebLinkColor := aclYellow;
  UpdateLayered;
end;

end.