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.