aboutbox.pas

省级集邮品管理ERP

{*******************************************************}
{                                                       }
{                        关于                           }
{                                                       }
{            中软金马公司版权所有。2002.12前            }
{                                                       }
{               编制：中软金马项目开发组                }
{                                                       }
{                                                       }
{*******************************************************}
(*
本模块在省级所有模块中调用。
*)

unit AboutBox;

interface

uses Windows, SysUtils, Classes, Graphics, Forms, Controls, StdCtrls,
  Buttons, ExtCtrls, Dialogs, GIFImage;

type
  TFrm_AboutBox = class(TForm)
    Panel1: TPanel;
    ProgramIcon: TImage;
    ProductName: TLabel;
    Version: TLabel;
    Copyright: TLabel;
    OKButton: TButton;
    lbl_versionInfo: TLabel;
    procedure FormCreate(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Frm_AboutBox: TFrm_AboutBox;

implementation

{$R *.DFM}

function GetBuildInfo: String;
var
  VerInfoSize: DWORD;
  VerInfo: Pointer;
  VerValueSize: DWORD;
  VerValue: PVSFixedFileInfo;
  Dummy: DWORD;
begin
  VerInfoSize := GetFileVersionInfoSize(PChar(ParamStr(0)), Dummy);
  GetMem(VerInfo, VerInfoSize);
  GetFileVersionInfo(PChar(ParamStr(0)), 0, VerInfoSize, VerInfo);
  VerQueryValue(VerInfo, '\', Pointer(VerValue), VerValueSize);

  if VerValue = nil then
  begin
    Result := '0';
    FreeMem(VerInfo, VerInfoSize);
    Exit;
  end;

  Result := IntToStr(VerValue^.dwFileVersionMS shr 16) + '.' +
    InttoStr(VerValue^.dwFileVersionMS and $FFFF) + '.' +
    IntToStr(VerValue^.dwFileVersionLS shr 16) + '.' +
    IntToStr(VerValue^.dwFileVersionLS and $FFFF);
  FreeMem(VerInfo, VerInfoSize);
end;


procedure TFrm_AboutBox.FormCreate(Sender: TObject);
begin
  try
    lbl_versionInfo.Caption := '版本号：' + GetBuildInfo;
  except
  end;
end;

end.