fmaboutbox.pas

Delphi的另一款钢琴软件

unit fmAboutBox;

interface

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

type
  TfmStdAboutBox = class(TForm)
    icoImage: TImage;
    stProductName: TLabel;
    stVersion: TLabel;
    stCopyright: TLabel;
    Label4: TLabel;
    stLicense1: TLabel;
    stLicense2: TLabel;
    Bevel1: TBevel;
    stMemAvail: TLabel;
    btnOK: TButton;
    stOS: TLabel;
    procedure FormShow(Sender: TObject);
  private
    keyName : string;
  public
    procedure GetLicenseInfo (var name, company : string);
    { Public declarations }
  end;

var
  fmStdAboutBox: TfmStdAboutBox;

implementation

{$R *.DFM}

uses Registry;

procedure TfmStdAboutBox.GetLicenseInfo (var name, company : string);
const
  REG_NAME = 'RegisteredOwner';
  REG_COMPANY = 'RegisteredOrganization';
var
  gotName : boolean;
  reg : TRegistry;
begin
  reg := TRegistry.Create;
  try
    reg.RootKey := HKEY_LOCAL_MACHINE;
    gotName := False;
    reg.OpenKey ('Software\Woozle\' + KeyName, True);
    if reg.ValueExists (REG_NAME) and reg.ValueExists (REG_COMPANY) then
    begin
      name := reg.ReadString (REG_NAME);
      company := reg.ReadString (REG_COMPANY);
      gotName := True
    end;

    if not gotName then with TRegistry.Create do
    try
      RootKey := HKEY_LOCAL_MACHINE;
      if OpenKey ('\Software\Microsoft\Windows NT\CurrentVersion', False) and
         ValueExists (REG_NAME) and
         ValueExists (REG_COMPANY) then
      begin
        company := ReadString (REG_COMPANY);
        name := ReadString (REG_NAME);
        gotName := True
      end;

      if (not GotName) and
         OpenKey ('\Software\Microsoft\Windows\CurrentVersion', False) and
         ValueExists (REG_NAME) and
         ValueExists (REG_COMPANY) then
      begin
        company := ReadString (REG_COMPANY);
        name := ReadString (REG_NAME);
        gotName := True
      end;

      if gotName then
      begin
        reg.WriteString (REG_NAME, name);
        reg.WriteString (REG_COMPANY, company)
      end
    finally
      free
    end;

  finally
    reg.Free
  end;

  if not GotName then
  begin
    name := 'Not registered';
    company := 'Unknown Organization'
  end
end;

procedure TfmStdAboutBox.FormShow(Sender: TObject);
var
  memoryStatus : TMemoryStatus;
  st1, st2 : string;
  memavail : extended;
  OSVersionInfo : TOSVersionInfo;
begin
  KeyName := ExtractFileName (Application.ExeName);
  if Pos ('.', KeyName) <> 0 then
    Delete (KeyName, pos ('.', KeyName), Length (KeyName));

  if caption = 'About' then
    if Application.Title <> '' then
      caption := 'About ' + Application.Title
    else
      caption := 'About ' + KeyName;

  if stProductName.caption = 'TITLE' then
    stProductName.Caption := caption;

  if Assigned (Application.Icon) then
    icoImage.Picture.Icon := Application.Icon;

  memoryStatus.dwLength := SizeOf (memoryStatus);
  GlobalMemoryStatus (memoryStatus);
  st1 := Copy (stMemAvail.Caption, 1, Pos (':', stMemAvail.Caption));
  memavail := memoryStatus.dwTotalPhys div 1024;
  st1 := st1 + Format ('%10.0n KB', [memavail]);
  stMemAvail.Caption := st1;
 
  if stOS.caption = 'OS' then
  begin
    osVersionInfo.dwOSVersionInfoSize := SizeOf (osVersionInfo);
    GetVersionEx (osVersionInfo);
    with osVersionInfo do
    begin
      case dwPlatformID of
        VER_PLATFORM_WIN32S : st1 := '3.1';
        VER_PLATFORM_WIN32_WINDOWS : st1 := '95';
        VER_PLATFORM_WIN32_NT : st1 := 'NT';
        else st1 := '?';
      end;
      stOS.Caption := Format ('Windows %s %d.%d (Build %d: %s)',
                                [st1, dwMajorVersion, dwMinorVersion, dwBuildNumber, szCSDVersion])
    end;

    if (stLicense1.Caption = 'LICENSE') or (stLicense2.Caption = 'LICENSE') then
      GetLicenseInfo (st1, st2);
    if stLicense1.Caption = 'LICENSE' then stLicense1.Caption := st1;
    if stLicense2.Caption = 'LICENSE' then stLicense2.Caption := st2;
  end
end;

end.