home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Softwarová Záchrana 3
/
Softwarova-zachrana-3.bin
/
ArsClip
/
source.zip
/
UnitFrmAbout.pas
< prev
next >
Wrap
Pascal/Delphi Source File
|
2002-06-04
|
2KB
|
93 lines
unit UnitFrmAbout;
{
What else is an about page for?
}
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, ExtCtrls, ShellAPI {for shellexecute};
type
TFrmAbout = class(TForm)
Image1: TImage;
Label1: TLabel;
lblVersion: TLabel;
Button1: TButton;
lblURL: TLabel;
Label3: TLabel;
Label4: TLabel;
procedure FormCreate(Sender: TObject);
procedure Button1Click(Sender: TObject);
procedure lblURLClick(Sender: TObject);
procedure lblURLMouseEnter(Sender: TObject);
procedure lblURLMouseLeave(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
FrmAbout: TFrmAbout;
implementation
{$R *.dfm}
procedure TFrmAbout.FormCreate(Sender: TObject);
var L, i : DWORD;
p, buf : Pointer;
ver : array [0 .. 3] of word;
begin
//
// So much damn work just to get the program's version info....
//
lblVersion.Caption := '';
L := Windows.GetFileVersionInfoSize(PChar(Application.EXEName), i);
if (L = 0) then begin
EXIT;
end;
GetMem(buf, L);
Windows.GetFileVersionInfo(PChar(Application.EXEName), 0, L, Buf);
Windows.VerQueryValue(Buf, '\', p, i);
Ver[0] := HiWord(TVSFixedFileInfo(p^).dwFileVersionMS);
Ver[1] := LoWord(TVSFixedFileInfo(p^).dwFileVersionMS);
Ver[2] := HiWord(TVSFixedFileInfo(p^).dwFileVersionLS);
Ver[3] := LoWord(TVSFixedFileInfo(p^).dwFileVersionLS);
FreeMem(Buf);
lblVersion.Caption := IntToStr(ver[0]) + '.' + IntToStr(ver[1]) + '.' + IntToStr(ver[2]);
end;
procedure TFrmAbout.Button1Click(Sender: TObject);
begin
self.Hide;
end;
//-------
// URL -
//-------
procedure TFrmAbout.lblURLClick(Sender: TObject);
begin
ShellAPI.ShellExecute(self.Handle, nil, PChar(lblURL.caption), nil, nil, SW_HIDE);
end;
procedure TFrmAbout.lblURLMouseEnter(Sender: TObject);
begin
lblURL.Cursor := crUpArrow;
end;
procedure TFrmAbout.lblURLMouseLeave(Sender: TObject);
begin
lblURL.Cursor := crDefault;
end;
end.