unit _fm_About; interface uses Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, ExtCtrls, StdCtrls; type Tfm_About = class(TForm) Image1 : TImage; laVersion : TLabel; laWWWName : TLabel; laWWW : TLabel; laEMail : TLabel; laEMailName: TLabel; laAuthorName: TLabel; laAuthorName2: TLabel; Label2 : TLabel; Label3 : TLabel; Label4 : TLabel; laVersion2: TLabel; Label1 : TLabel; Label5 : TLabel; Label6 : TLabel; tmAppearance: TTimer; procedure FormCreate(Sender: TObject); procedure Image1Click(Sender: TObject); procedure laWWWNameClick(Sender: TObject); procedure laEMailNameClick(Sender: TObject); procedure Image1MouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); procedure Image1MouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); procedure laEMailNameMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer); procedure laWWWNameMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer); procedure Image1MouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer); procedure tmAppearanceTimer(Sender: TObject); private { Private declarations } // procedure WMNCHitTest(var Message : TWMNCHitTest); message WM_NCHITTEST; public { Public declarations } TranspValue: integer; FormRaise: boolean; end; var fm_About : Tfm_About; implementation uses FMXUtils, _fm_Main; {$R *.DFM} {------------------------------------------------------------------------------} procedure Tfm_About.tmAppearanceTimer(Sender: TObject); begin SetOpacity(fm_Main.Handle, 255 - TranspValue); SetOpacity(fm_About.Handle, TranspValue+45); inc(TranspValue,10*integer(FormRaise) - 5); {Close Finished} if (TranspValue<=0) then begin tmAppearance.Enabled := false; fm_About.Close; SetWindowLong(fm_Main.Handle, GWL_EXSTYLE, _iWindowExStyle); end; {Show Finished} if (TranspValue>=200) then begin tmAppearance.Enabled := false; end; end; {------------------------------------------------------------------------------} procedure Tfm_About.FormCreate(Sender: TObject); const Step = 25; HorBlocks = 15; VerBlocks = 9; var i,Incr : Integer; p : array[1..100] of TPoint; begin @SetLayeredWindowAttributes := GetProcAddress(LoadLibrary('user32.dll'), 'SetLayeredWindowAttributes'); SetOpacity(Handle,0); // SetOpacity(Handle, 0); Incr := 1; for i:=0 to Trunc((HorBlocks-1)/2)-1 do begin p[i*4+Incr ] := Point(Step* i*2 ,0 ); p[i*4+Incr+1] := Point(Step*(i*2 + 1),0 ); p[i*4+Incr+2] := Point(Step*(i*2 + 1),Step); p[i*4+Incr+3] := Point(Step*(i*2 + 2),Step); end; p[i*4+1] := Point(Step*i*2 ,0 ); Incr := i*4+1 + 1; for i:=0 to Trunc((VerBlocks-1)/2)-1 do begin p[i*4+Incr ] := Point(Step* HorBlocks ,Step* i*2 ); p[i*4+Incr+1] := Point(Step* HorBlocks ,Step*(i*2 + 1)); p[i*4+Incr+2] := Point(Step*(HorBlocks - 1),Step*(i*2 + 1)); p[i*4+Incr+3] := Point(Step*(HorBlocks - 1),Step*(i*2 + 2)); end; p[i*4+Incr] := Point(Step*HorBlocks,Step*i*2 ); Incr := i*4+Incr + 1; for i:=0 to Trunc((HorBlocks-1)/2)-1 do begin p[i*4+Incr ] := Point(Step*(HorBlocks - (i*2) ),Step* VerBlocks ); p[i*4+Incr+1] := Point(Step*(HorBlocks - (i*2) - 1),Step* VerBlocks ); p[i*4+Incr+2] := Point(Step*(HorBlocks - (i*2) - 1),Step*(VerBlocks - 1)); p[i*4+Incr+3] := Point(Step*(HorBlocks - (i*2) - 2),Step*(VerBlocks - 1)); end; p[i*4+Incr] := Point(Step*(HorBlocks - (i*2)) ,Step*VerBlocks); Incr := i*4+Incr + 1; for i:=0 to Trunc((VerBlocks-1)/2)-1 do begin p[i*4+Incr ] := Point(Step*0,Step*(VerBlocks - (i*2) )); p[i*4+Incr+1] := Point(Step*0,Step*(VerBlocks - (i*2) - 1)); p[i*4+Incr+2] := Point(Step*1,Step*(VerBlocks - (i*2) - 1)); p[i*4+Incr+3] := Point(Step*1,Step*(VerBlocks - (i*2) - 2)); end; p[i*4+Incr] := Point(Step*0,Step*(VerBlocks - (i*2)) ); Incr := i*4+Incr + 1; SetWindowRgn(Handle, CreatePolygonRgn(p,Incr-1,WINDING), True); end; {------------------------------------------------------------------------------} procedure Tfm_About.Image1Click(Sender: TObject); var i : integer; begin FormRaise := false; tmAppearance.Enabled := true; // Close end; {------------------------------------------------------------------------------} procedure Tfm_About.laWWWNameClick(Sender: TObject); begin ExecuteFile(laWWWName.Caption,'',''); end; {------------------------------------------------------------------------------} procedure Tfm_About.laEMailNameClick(Sender: TObject); begin ExecuteFile('mailto:'+laEMailName.Caption+'?Subject='+Application.Title,'',''); end; {------------------------------------------------------------------------------} procedure Tfm_About.Image1MouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); begin fm_About.Top := fm_About.Top + 2; fm_About.Left := fm_About.Left + 2; end; {------------------------------------------------------------------------------} procedure Tfm_About.Image1MouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); begin fm_About.Top := fm_About.Top - 2; fm_About.Left := fm_About.Left - 2; end; {------------------------------------------------------------------------------} procedure Tfm_About.laEMailNameMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer); begin laEMailName.Font.Color := clRed; laWWWName.Font.Color := clBlue; end; {------------------------------------------------------------------------------} procedure Tfm_About.laWWWNameMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer); begin laWWWName.Font.Color := clRed; laEMailName.Font.Color := clBlue; end; {------------------------------------------------------------------------------} procedure Tfm_About.Image1MouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer); begin laEMailName.Font.Color := clBlue; laWWWName.Font.Color := clBlue; end; {------------------------------------------------------------------------------} end.