unitabout.pas

一个背单词程序。是我闲着没事做的。 给大家看看

unit UnitAbout;

interface

uses Windows, SysUtils, Classes, Graphics, Forms, Controls, StdCtrls,
  Buttons, ExtCtrls,shellAPI, jpeg;

type
  TAboutBox = class(TForm)
    ProgramIcon: TImage;
    ProductName: TLabel;
    Copyright: TLabel;
    Comments: TLabel;
    OKButton: TButton;
    Label1: TLabel;
    Label2: TLabel;
    Bevel1: TBevel;
    Label3: TLabel;
    Label4: TLabel;
    Label5: TLabel;
    Label6: TLabel;
    Label7: TLabel;
    Label8: TLabel;
    Label9: TLabel;
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure FormShow(Sender: TObject);
    procedure Label3MouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure FormMouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure Label3MouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
    procedure Label3MouseEnter(Sender: TObject);
    procedure Label3MouseLeave(Sender: TObject);
    procedure FormPaint(Sender: TObject);

  private
         { Private declarations }
  public
    { Public declarations }
  end;

var
  AboutBox: TAboutBox;

    function GetIdeDiskSerialNumber : String;
implementation

{$R *.dfm}

procedure TAboutBox.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  Action:=cafree;
  AboutBox:=nil;
end;

procedure TAboutBox.FormShow(Sender: TObject);
var MS: TMemoryStatus;
    sysinfo:Tsysteminfo;
    DeviceMode: TDeviceMode;
    x,y:integer;
    sec1, byt1, cl1, cl2:longword;
    driver:Pchar;
begin
  //ProgramIcon.Picture.Assign(Application.Icon);
  GlobalMemoryStatus(MS);
  Label1.Caption:=Format('可用内存: %s MB 总共内存: %s MB ',
      [Formatfloat('###,##0',MS.dwAvailPhys /1024/1024),
        Formatfloat('###,##0',MS.dwTotalPhys /1024/1024) ]);
  Label9.Caption:=Format('虚拟可用:%S MB,虚拟总共:%S MB',
       [Formatfloat('###,##0',MS.dwAvailVirTual /1024/1024),
        Formatfloat('###,##0',MS.dwTotalVirtual /1024/1024) ]);
  Label2.Caption:=Format('系统资源使用率:  %d%%',[MS.dwMemoryLoad]);
  label8.Caption:='硬盘序列号：['+GetIdeDiskSerialNumber+']';
  getsysteminfo(sysinfo);
  label4.caption:='CPU类型：'+inttostr(sysinfo.dwProcessorType);
  x:=getsystemmetrics(0);
  y:=getsystemmetrics(1);
  EnumDisplaySettings(nil, Cardinal(-1), DeviceMode);
  label5.caption:=Format('屏幕分辨率：%S*%S/%d',[inttostr(x),inttostr(y),DeviceMode.dmDisplayFrequency]);
   driver:='C:\';
  GetDiskFreeSpace(driver, sec1, byt1, cl1, cl2);
  cl1 := cl1 * sec1 * byt1;
  cl2 := cl2 * sec1 * byt1;
  Label6.Caption := 'C：盘总共容量: ' + Formatfloat('###,##0',cl2/1024/1024/100*2) + ' GB';
  Label7.Caption := 'C：盘可用容量: ' + Formatfloat('###,##0',cl1/1024/1024/100) + ' GB';



end;

procedure TAboutBox.Label3MouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
 ShellExecute(Handle, 'open', 'http://www.shyptec.com', nil, nil, SW_SHOW);
end;


//取Ide硬盘序列号函数
function GetIdeDiskSerialNumber : String;
type
TSrbIoControl = packed record
HeaderLength : ULONG;
Signature : Array[0..7] of Char; 
Timeout : ULONG; 
ControlCode : ULONG; 
ReturnCode : ULONG; 
Length : ULONG; 
end; 
SRB_IO_CONTROL = TSrbIoControl; 
PSrbIoControl = ^TSrbIoControl; 

TIDERegs = packed record 
bFeaturesReg : Byte; // Used for specifying SMART "commands".
bSectorCountReg : Byte; // IDE sector count register 
bSectorNumberReg : Byte; // IDE sector number register 
bCylLowReg : Byte; // IDE low order cylinder value 
bCylHighReg : Byte; // IDE high order cylinder value 
bDriveHeadReg : Byte; // IDE drive/head register 
bCommandReg : Byte; // Actual IDE command. 
bReserved : Byte; // reserved. Must be zero. 
end; 
IDEREGS = TIDERegs; 
PIDERegs = ^TIDERegs; 

TSendCmdInParams = packed record 
cBufferSize : DWORD; 
irDriveRegs : TIDERegs; 
bDriveNumber : Byte; 
bReserved : Array[0..2] of Byte; 
dwReserved : Array[0..3] of DWORD; 
bBuffer : Array[0..0] of Byte; 
end; 
SENDCMDINPARAMS = TSendCmdInParams; 
PSendCmdInParams = ^TSendCmdInParams; 

TIdSector = packed record 
wGenConfig : Word; 
wNumCyls : Word; 
wReserved : Word; 
wNumHeads : Word; 
wBytesPerTrack : Word; 
wBytesPerSector : Word; 
wSectorsPerTrack : Word; 
wVendorUnique : Array[0..2] of Word; 
sSerialNumber : Array[0..19] of Char; 
wBufferType : Word; 
wBufferSize : Word; 
wECCSize : Word; 
sFirmwareRev : Array[0..7] of Char; 
sModelNumber : Array[0..39] of Char; 
wMoreVendorUnique : Word; 
wDoubleWordIO : Word; 
wCapabilities : Word; 
wReserved1 : Word; 
wPIOTiming : Word; 
wDMATiming : Word; 
wBS : Word; 
wNumCurrentCyls : Word; 
wNumCurrentHeads : Word; 
wNumCurrentSectorsPerTrack : Word; 
ulCurrentSectorCapacity : ULONG; 
wMultSectorStuff : Word;
ulTotalAddressableSectors : ULONG;
wSingleWordDMA : Word; 
wMultiWordDMA : Word; 
bReserved : Array[0..127] of Byte; 
end; 
PIdSector = ^TIdSector; 

const 
IDE_ID_FUNCTION = $EC; 
IDENTIFY_BUFFER_SIZE = 512; 
DFP_RECEIVE_DRIVE_DATA = $0007c088; 
IOCTL_SCSI_MINIPORT = $0004d008; 
IOCTL_SCSI_MINIPORT_IDENTIFY = $001b0501; 
DataSize = sizeof(TSendCmdInParams)-1+IDENTIFY_BUFFER_SIZE;
BufferSize = SizeOf(SRB_IO_CONTROL)+DataSize;
W9xBufferSize = IDENTIFY_BUFFER_SIZE+16; 
var 
hDevice : THandle; 
cbBytesReturned : DWORD; 
pInData : PSendCmdInParams; 
pOutData : Pointer; // PSendCmdOutParams 
Buffer : Array[0..BufferSize-1] of Byte; 
srbControl : TSrbIoControl absolute Buffer; 

procedure ChangeByteOrder( var Data; Size : Integer ); 
var ptr : PChar; 
i : Integer; 
c : Char; 
begin 
ptr := @Data; 
for i := 0 to (Size shr 1)-1 do 
begin 
c := ptr^; 
ptr^ := (ptr+1)^; 
(ptr+1)^ := c; 
Inc(ptr,2); 
end; 
end; 

begin 
Result := ''; 
FillChar(Buffer,BufferSize,#0); 
if Win32Platform=VER_PLATFORM_WIN32_NT then 
begin // Windows NT, Windows 2000 
// Get SCSI port handle 
hDevice := CreateFile( '\\.\Scsi0:', 
GENERIC_READ or GENERIC_WRITE, 
FILE_SHARE_READ or FILE_SHARE_WRITE, 
nil, OPEN_EXISTING, 0, 0 ); 
if hDevice=INVALID_HANDLE_VALUE then Exit; 
try 
srbControl.HeaderLength := SizeOf(SRB_IO_CONTROL); 
System.Move('SCSIDISK',srbControl.Signature,8);
srbControl.Timeout := 2;
srbControl.Length := DataSize;
srbControl.ControlCode := IOCTL_SCSI_MINIPORT_IDENTIFY;
pInData := PSendCmdInParams(PChar(@Buffer) 
+SizeOf(SRB_IO_CONTROL)); 
pOutData := pInData; 
with pInData^ do 
begin 
cBufferSize := IDENTIFY_BUFFER_SIZE; 
bDriveNumber := 0; 
with irDriveRegs do 
begin 
bFeaturesReg := 0; 
bSectorCountReg := 1; 
bSectorNumberReg := 1; 
bCylLowReg := 0; 
bCylHighReg := 0; 
bDriveHeadReg := $A0; 
bCommandReg := IDE_ID_FUNCTION; 
end; 
end; 
if not DeviceIoControl( hDevice, IOCTL_SCSI_MINIPORT, 
@Buffer, BufferSize, @Buffer, BufferSize, 
cbBytesReturned, nil ) then Exit; 
finally 
CloseHandle(hDevice); 
end; 
end 
else 
begin // Windows 95 OSR2, Windows 98 
hDevice := CreateFile( '\\.\SMARTVSD', 0, 0, nil, 
CREATE_NEW, 0, 0 ); 
if hDevice=INVALID_HANDLE_VALUE then Exit; 
try 
pInData := PSendCmdInParams(@Buffer); 
pOutData := @pInData^.bBuffer; 
with pInData^ do 
begin 
cBufferSize := IDENTIFY_BUFFER_SIZE; 
bDriveNumber := 0; 
with irDriveRegs do 
begin 
bFeaturesReg := 0; 
bSectorCountReg := 1; 
bSectorNumberReg := 1; 
bCylLowReg := 0; 
bCylHighReg := 0; 
bDriveHeadReg := $A0; 
bCommandReg := IDE_ID_FUNCTION; 
end; 
end; 
if not DeviceIoControl( hDevice, DFP_RECEIVE_DRIVE_DATA, 
pInData, SizeOf(TSendCmdInParams)-1, pOutData, 
W9xBufferSize, cbBytesReturned, nil ) then Exit; 
finally 
CloseHandle(hDevice); 
end; 
end; 
with PIdSector(PChar(pOutData)+16)^ do 
begin 
ChangeByteOrder(sSerialNumber,SizeOf(sSerialNumber)); 
SetString(Result,sSerialNumber,SizeOf(sSerialNumber)); 
end; 
end; 

//画渐层色
procedure drawzc(form:Tform);
var i:word;
yy:real;
r,g:Byte;
begin
yy:=0;
r:=random(255);
g:=random(255);
if r<100 then r:=255;
if g<100 then g:=255;
for i:=0 to form.clientheight do
begin
form.canvas.brush.color:=rgb(r,g,255-MulDiv(i,255,form.clientheight));
form.canvas.fillrect(rect(0,round(yy),form.clientwidth,round(yy+1)));
yy:=yy+1;
end;
end;
      
procedure TAboutBox.FormMouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
drawzc(self);
self.Repaint; //重画控件
end;
procedure TAboutBox.Label3MouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
begin
 // label3.Caption:=Label3.Caption+inttostr(x)+','+inttostr(label3.left );
end;

procedure TAboutBox.Label3MouseLeave(Sender: TObject);
begin
with label3.Font  do
   begin
   Color:=clBlack;
   Style:=[];
   end;
end;

procedure TAboutBox.Label3MouseEnter(Sender: TObject);
begin
 with label3.Font  do
   begin
   Color:=clBlue;
   Style:=[fsbold,fsunderline];
end;
end;
procedure TAboutBox.FormPaint(Sender: TObject);
begin
drawzc(self);
end;

end.

procedure TAboutBox.ProgramIconClick(Sender: TObject);
begin

end;