unitabout.pas

远程抄表系统的客户端程序 安徽六安项目-客户端程序 0 开发环境 Delphi 7.0 所需控件 mxOutlookBar 数 据 库 Sybase 11.5 1 04-12-

unit UnitAbout;

interface

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

const
  KeyPath   = 'SOFTWARE\Microsoft\Windows\CurrentVersion';
  User      = 'RegisteredOwner';
  Company   = 'RegisteredOrganization';
  NTKeyPath = 'SOFTWARE\Microsoft\windows NT\CurrentVersion';
  Ver       = '客户端(朝阳建平)';
type
  TFormAbout = class(TForm)
    Panel1: TPanel;
    ProgramIcon: TImage;
    ProductName: TLabel;
    Version: TLabel;
    Copyright: TLabel;
    BitBtn1: TBitBtn;
    Bevel1: TBevel;
    lbl_Os: TLabel;
    lbl_Memory: TLabel;
    Panel2: TPanel;
    Image1: TImage;
    Others: TLabel;
    Author: TLabel;
    lbl_User: TLabel;
    lbl_Company: TLabel;
    Bevel2: TBevel;
    procedure FormCreate(Sender: TObject);
    procedure BitBtn1Click(Sender: TObject);
    procedure FormShow(Sender: TObject);
    procedure BitBtn1KeyPress(Sender: TObject; var Key: Char);
  private
  { Private declarations }
    procedure GetOSInfo;     //系统信息程序
    Procedure GetMemoryInfo; //可用资源程序
  public
  { Public declarations }
end;

var
  FormAbout: TFormAbout;

implementation

{$R *.DFM}

Procedure TFormAbout.GetMemoryInfo ;//可用资源
var
  MS: TMemoryStatus;
begin
  MS.dwLength := SizeOf(TMemoryStatus);
  GlobalMemoryStatus(MS);
  lbl_Memory.Caption := lbl_Memory.Caption + FormatFloat('#,###" KB"',MS.dwTotalPhys div 1024);
end;

procedure TFormAbout.GetOSInfo; //获取系统信息
var
  platInfo: string;
  BuildNumber: Integer;
begin
  case Win32Platform of
  VER_PLATFORM_WIN32_WINDOWS:
    begin
      platInfo := 'Windows 95';
      BuildNumber := Win32BuildNumber and $0000FFFF;
    end;

  VER_PLATFORM_WIN32_NT:
    begin
      platInfo := 'Windows NT';
      BuildNumber := Win32BuildNumber;
    end;
    else
    begin
      platInfo := 'Windows';
      BuildNumber := 0;
    end;
  end;

  if(Win32Platform = VER_PLATFORM_WIN32_WINDOWS)
    or(Win32Platform = VER_PLATFORM_WIN32_NT) then
  begin
    if Win32CSDVersion = '' then
      lbl_OS.Caption := lbl_OS.Caption + Format('%s%s          %d.%d (Build %d)', [platInfo, #13, Win32MajorVersion, Win32MinorVersion, BuildNumber])
    else
      lbl_OS.Caption := lbl_OS.Caption + Format('%s%s          %d.%d (Build %d: %s)', [platInfo, #13, Win32MajorVersion, Win32MinorVersion, BuildNumber, Win32CSDVersion]);
  end
  else
    lbl_OS.Caption := lbl_OS.Caption + Format('%s%s          %d.%d', [platInfo, #13, Win32MajorVersion, Win32MinorVersion])
end;

procedure TFormAbout.FormCreate(Sender: TObject);
begin
  try
    Caption := '关于' + Application.Title;
    ProgramIcon.Picture.Icon := Application.Icon;
    ProductName.Caption := ProductName.Caption + Application.Title;
    Version.Caption   := Version.Caption + Ver;
    Copyright.Caption := Copyright.Caption + '锦州拓新电力电子公司';
    Author.Caption := Author.Caption + '刘伟明';
    Others.Caption := '运行环境：本程序运行于Windows9x/NT/XP/2000/2003' + #13 + #13 +
                      '数 据 库: Sybase 11.5' + #13 + #13 +
                      '开发语言：Delphi 7.0'  + #13 + #13 +
                      '警    告：未经允许，任何个人、单位不可以以任何方式非法拷贝、盗用本程序，'+
                      '本系统在运行过程中出现的问题请直接和拓新公司联系，客户服务电话：[phone]。' + #13 + #13;

    //初始化---------------------------
    GetMemoryInfo;
    GetOsinfo;
  except
    MessageBox(Handle,'无法取得某些信息','提示',MB_OK);
  end;
end;

procedure TFormAbout.BitBtn1Click(Sender: TObject);
begin
  Close;
  //  Action := caFree;
end;

procedure  GetUserInfo(var UserName, CompanyName: string);
var
  MyReg: TRegistry;
begin
  MyReg := TRegistry.Create;
  MyReg.RootKey := HKEY_LOCAL_MACHINE;
  MyReg.OpenKey(KeyPath,False);
  if not MyReg.ValueExists(User) or not MyReg.ValueExists(Company) then begin
    MyReg.CloseKey;
    MyReg.OpenKey(NTKeyPath, False);
  end;
  UserName    := MyReg.ReadString(User);
  CompanyName := MyReg.ReadString(Company);
  MyReg.CloseKey;
  MyReg.Free;
end;

procedure TFormAbout.FormShow(Sender: TObject);
var
  UserName, CompanyName: string;
begin
  GetUserInfo(UserName,CompanyName);
  lbl_User.Caption    := UserName;
  lbl_Company.Caption := CompanyName;
end;

procedure TFormAbout.BitBtn1KeyPress(Sender: TObject; var Key: Char);
begin
 if Key = #13 then
    Close();

  if Key = #27 then
    Close();
end;

end.