aboutfrm.~pas

一小的学生成绩管理系统,是学习DELPHI的好资料.

unit AboutFrm;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ComCtrls, ToolWin, ExtCtrls, StdCtrls,
   Buttons;
const
  WS_EX_LAYERED = $80000;
  AC_SRC_OVER = $0;
  AC_SRC_ALPHA = $1;
  AC_SRC_NO_PREMULT_ALPHA = $1;
  AC_SRC_NO_ALPHA = $2;
  AC_DST_NO_PREMULT_ALPHA = $10;
  AC_DST_NO_ALPHA = $20;
  LWA_COLORKEY = $1;
  LWA_ALPHA = $2;
  ULW_COLORKEY = $1;
  ULW_ALPHA = $2;
  ULW_OPAQUE = $4;
//新增加的常量定义

type
  TAboutForm = class(TForm)
    Bevel1: TBevel;
    Panel1: TPanel;
    Author: TPaintBox;
    ProductName: TLabel;
    Version: TLabel;
    lblOs: TLabel;
    lblMemory: TLabel;
    Copyright: TLabel;
    others: TLabel;
    OKBtn: TSpeedButton;
    ProgramIcon: TImage;
    procedure FormCreate(Sender: TObject);
    procedure ProgramIconClick(Sender: TObject);
    procedure OKBtnClick(Sender: TObject);
    procedure FormKeyPress(Sender: TObject; var Key: Char);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
  private
   s:string;
   Procedure Delay(x,y:word);//延时程序
   procedure GetOSInfo; //系统信息程序
   Procedure GetMemoryInfo ; //可用资源程序
    { Private declarations }
  public
    { Public declarations }
  end;

var
  AboutForm: TAboutForm;
  timeout:TDateTime;
implementation

uses MainFrm;

{$R *.dfm}
Procedure TAboutForm.GetMemoryInfo ;//可用资源
var
MS: TMemoryStatus;
begin
    MS.dwLength := SizeOf(TMemoryStatus);
    GlobalMemoryStatus(MS);
lblMemory.Caption :=lblMemory.Caption +FormatFloat('#,###" KB"', MS.dwTotalPhys div 1024);
end;

procedure TAboutForm.GetOSInfo; //获取系统信息
var
   Platform: string;
   BuildNumber: Integer;
begin
   case Win32Platform of
      VER_PLATFORM_WIN32_WINDOWS:
      begin
         if (Win32MajorVersion=4) and (Win32MinorVersion=10) then
            Platform :='Windows 98'
         else
            Platform := 'Windows 95';
         BuildNumber := Win32BuildNumber and $0000FFFF;
      end;
      VER_PLATFORM_WIN32_NT:
      begin
         if (Win32MajorVersion=5) and (Win32MinorVersion=0) then
            Platform := 'Windows 2000'
         else if (Win32MajorVersion=5) and (Win32MinorVersion=1) then
            Platform := 'Windows XP'
         else if (Win32MajorVersion=4) and (Win32MinorVersion=0) then
            Platform := 'Windows NT 4.0'
         else
            Platform := 'Windows NT'; 
         BuildNumber := Win32BuildNumber;
      end;
      else
      begin
         Platform := 'Windows';
         BuildNumber := 0;
      end;
   end;
   if (Win32Platform = VER_PLATFORM_WIN32_WINDOWS) or
      (Win32Platform = VER_PLATFORM_WIN32_NT) then
   begin
      if Win32CSDVersion = '' then
         lblOS.Caption := lblOS.Caption+Format('%s 版本 %d.%d （内部版本 %d）', [Platform, Win32MajorVersion,
            Win32MinorVersion, BuildNumber])
      else
         lblOS.Caption := lblOS.Caption+Format('%s 版本 %d.%d （内部版本 %d: %s）', [Platform, Win32MajorVersion,
            Win32MinorVersion, BuildNumber, Win32CSDVersion]);
   end
   else
      lblOS.Caption := lblOS.Caption+Format('%s %d.%d', [Platform, Win32MajorVersion,
      Win32MinorVersion])
   end;

procedure TAboutForm.Delay(x,y:word);
begin
//该成为WINDOWS APP启动时间这个函数来做!
timeout:=now+encodeTime(0,x div 60,x mod 60,y);
While now<timeout do
  Application.ProcessMessages;
end;

procedure TAboutForm.FormCreate(Sender: TObject);
begin
   try
      self.Caption :=application.Title + ' - ';
      self.Caption :=self.caption+'关于本软件';
      ProgramIcon.Picture.icon:=Application.Icon; //图标
      ProductName.Caption:=ProductName.Caption+Application.Title;//产品名称
      version.Caption:=version.Caption+'1.0'; //版本
      Copyright.Caption:=Copyright.Caption+'Maskey Studio          （2002- ）';
      others.Caption:='警  告：本系统为共享软件，你可以随意的拷贝、使用；但是，'+#13
                     +'        任何未经授权的非法修改都将被禁止！否则，系统在运'+#13
                     +'        行过程中出现的任何问题，作者将不负任何连带责任！'+#13
                     +'        并且，本公司及作者保留该程序的最终版权。';
      ////初始化---------------------------
      GetMemoryInfo;
      GetOsinfo;
      //初始化变量s...
      s:='';
   except
      MessageBox(handle,'在提取系统信息时某些信息不能取得','提示',MB_OK);
   end;
end;

procedure TAboutForm.ProgramIconClick(Sender: TObject);
var i,fontheight:Byte;
begin
try
panel1.Hide;
fontheight:=author.Canvas.TextHeight('A');
for i:=0 to 150+fontHeight*8 do
if not panel1.Visible then //在此处添加说明
with author.Canvas do
begin
textout(25,100-i,'感谢您使用【'+Application.Title+'】系统！');
textout(25,100+fontheight-i,'');
textout(25,100+fontheight*2-i,'系统说明——');
textout(25,100+fontheight*3-i,'软件作者：小 马');
textout(25,100+fontheight*4-i,'开发前端：Borland Delphi 6.6');
textout(25,100+fontheight*5-i,'数据处理：Borland Paradox 7.0');
textout(25,100+fontheight*6-i,'开发时间：2002年7月');
textout(25,100+fontheight*7-i,'');
textout(25,100+fontheight*8-i,'技术支持——');
textout(25,100+fontheight*9-i,'热线支持：[phone] 小马');
textout(25,100+fontheight*10-i,'手机支持：013683098520 小马');
textout(25,100+fontheight*11-i,'电子邮件：WWW.Maskey.Sina.COM');
textout(25,100+fontheight*12-i,'网上服务：WWW.Maskey.Sina.COM');
textout(25,100+fontheight*13-i,' ');
textout(25,100+fontheight*14-i,'Maskey Studio ');
textout(25,100+fontheight*15-i,'最后编译日期：'+formatdatetime('yyyy-mm-dd',now));
Delay(0,50);
end;
finally
panel1.Show;
self.Refresh;
end;

end;

procedure TAboutForm.OKBtnClick(Sender: TObject);
begin
   panel1.Show ;
   OkBtn.Enabled:=False;
   ProgramIconclick(sender);
   OkBtn.Enabled:=True;
   self.Close ;
end;

procedure TAboutForm.FormKeyPress(Sender: TObject; var Key: Char);
begin
   s:=s+key; //用户输入"Author"则显示
   if StrUpper(Pchar(s))='A' then
   begin
      ProgramIconclick(sender);
      s:=''
   end;
end;

procedure TAboutForm.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  if Application.Tag>0 then
     MainForm.Show;
  Application.Tag:=Application.Tag+1;
  AboutForm.Tag:=13;
end;


procedure TAboutForm.FormCloseQuery(Sender: TObject;
  var CanClose: Boolean);
begin
  if OkBtn.Enabled=False then
     CanClose:=False;
end;

end.