home *** CD-ROM | disk | FTP | other *** search
/ Softwarová Záchrana 3 / Softwarova-zachrana-3.bin / StartRight / source.zip / UnitFrmAbout.pas < prev    next >
Pascal/Delphi Source File  |  2002-10-26  |  2KB  |  105 lines

  1. unit UnitFrmAbout;
  2. {
  3.     Purpose:
  4.         What else is an about page for?
  5. }
  6.  
  7. interface
  8.  
  9. uses
  10.   Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  11.   Dialogs, StdCtrls, ExtCtrls, ShellAPI {for shellexecute};
  12.  
  13. type
  14.   TFrmAbout = class(TForm)
  15.     Image1: TImage;
  16.     Label1: TLabel;
  17.     lblVersion: TLabel;
  18.     Button1: TButton;
  19.     lblURL: TLabel;
  20.     Label3: TLabel;
  21.     Label4: TLabel;
  22.     procedure FormCreate(Sender: TObject);
  23.     procedure Button1Click(Sender: TObject);
  24.     procedure lblURLClick(Sender: TObject);
  25.     procedure lblURLMouseEnter(Sender: TObject);
  26.     procedure lblURLMouseLeave(Sender: TObject);
  27.   private
  28.     { Private declarations }
  29.   public
  30.     { Public declarations }
  31.         //function GetVersionString(filename : string) : string;
  32.   end;
  33.  
  34. var
  35.   FrmAbout: TFrmAbout;
  36.  
  37.  
  38.  function GetVersionString(filename : string) : string;
  39.  
  40. implementation
  41.  
  42. {$R *.dfm}
  43.  
  44.  
  45. function GetVersionString(filename : string) : string;
  46. var L, i : DWORD;
  47.     p, buf : Pointer;
  48.     ver : array [0 .. 3] of word;
  49. begin
  50.  
  51.     L := Windows.GetFileVersionInfoSize(PChar(filename), i);
  52.     if (L = 0) then begin
  53.         EXIT;
  54.     end;
  55.  
  56.  
  57.     GetMem(buf, L);
  58.         Windows.GetFileVersionInfo(PChar(filename), 0, L, Buf);
  59.         Windows.VerQueryValue(Buf, '\', p, i);
  60.  
  61.         Ver[0] := HiWord(TVSFixedFileInfo(p^).dwFileVersionMS);
  62.         Ver[1] := LoWord(TVSFixedFileInfo(p^).dwFileVersionMS);
  63.         Ver[2] := HiWord(TVSFixedFileInfo(p^).dwFileVersionLS);
  64.         Ver[3] := LoWord(TVSFixedFileInfo(p^).dwFileVersionLS);
  65.     FreeMem(Buf);
  66.  
  67.     result := IntToStr(ver[0]) + '.' + IntToStr(ver[1]) + '.' + IntToStr(ver[2]);
  68. end;
  69.  
  70. procedure TFrmAbout.FormCreate(Sender: TObject);
  71. begin
  72.     //
  73.     // So much damn work just to get the program's version info....
  74.     //
  75.     lblVersion.Caption := '';
  76.     lblVersion.Caption := GetVersionString( Application.EXEName );
  77. end;
  78.  
  79. procedure TFrmAbout.Button1Click(Sender: TObject);
  80. begin
  81.     self.Hide;
  82. end;
  83.  
  84.  
  85.  
  86. //-------
  87. // URL -
  88. //-------
  89. procedure TFrmAbout.lblURLClick(Sender: TObject);
  90. begin
  91.     ShellAPI.ShellExecute(self.Handle, nil, PChar(lblURL.caption), nil, nil, SW_HIDE);
  92. end;
  93.  
  94.  
  95. procedure TFrmAbout.lblURLMouseEnter(Sender: TObject);
  96. begin
  97.     lblURL.Cursor := crUpArrow;
  98. end;
  99. procedure TFrmAbout.lblURLMouseLeave(Sender: TObject);
  100. begin
  101.     lblURL.Cursor := crDefault;
  102. end;
  103.  
  104. end.
  105.