home *** CD-ROM | disk | FTP | other *** search
- 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.
-