home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Softwarová Záchrana 3
/
Softwarova-zachrana-3.bin
/
StartRight
/
source.zip
/
UnitFrmAbout.pas
< prev
next >
Wrap
Pascal/Delphi Source File
|
2002-10-26
|
2KB
|
105 lines
unit UnitFrmAbout;
{
Purpose:
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 }
//function GetVersionString(filename : string) : string;
end;
var
FrmAbout: TFrmAbout;
function GetVersionString(filename : string) : string;
implementation
{$R *.dfm}
function GetVersionString(filename : string) : string;
var L, i : DWORD;
p, buf : Pointer;
ver : array [0 .. 3] of word;
begin
L := Windows.GetFileVersionInfoSize(PChar(filename), i);
if (L = 0) then begin
EXIT;
end;
GetMem(buf, L);
Windows.GetFileVersionInfo(PChar(filename), 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);
result := IntToStr(ver[0]) + '.' + IntToStr(ver[1]) + '.' + IntToStr(ver[2]);
end;
procedure TFrmAbout.FormCreate(Sender: TObject);
begin
//
// So much damn work just to get the program's version info....
//
lblVersion.Caption := '';
lblVersion.Caption := GetVersionString( Application.EXEName );
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.