mainform.pas

详细讲述如何用delphi进行com编程

unit MainForm;

interface

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

type
  TForm1 = class(TForm)
    Label1: TLabel;
    Label2: TLabel;
    Label3: TLabel;
    Label4: TLabel;
    Label5: TLabel;
    Label6: TLabel;
    Label7: TLabel;
    Label8: TLabel;
    Label9: TLabel;
    lblArrayCreate: TLabel;
    lblVariantCreate: TLabel;
    lblLockedVariantCreate: TLabel;
    lblLockedVariantLock: TLabel;
    lblArrayWrite: TLabel;
    lblVariantWrite: TLabel;
    lblLockedVariantWrite: TLabel;
    lblArrayRead: TLabel;
    lblVariantRead: TLabel;
    lblLockedVariantRead: TLabel;
    lblLockedVariantUnlock: TLabel;
    lblArrayDestroy: TLabel;
    lblVariantDestroy: TLabel;
    lblLockedVariantDestroy: TLabel;
    btnRun: TButton;
    Bevel1: TBevel;
    Bevel2: TBevel;
    Bevel3: TBevel;
    Label10: TLabel;
    ecArraySize: TEdit;
    procedure btnRunClick(Sender: TObject);
  private
    FArraySize: Integer;
    procedure TestArray;
    procedure TestLockedVariant;
    procedure TestVariant;
    { Private declarations }
  public
    { Public declarations }
  end;

  TTestArray = array[1 .. 1000000] of Integer;
  PTestArray = ^TTestArray;

var
  Form1: TForm1;

implementation

{$R *.DFM}

procedure TForm1.TestArray;
var
  T1, T2: DWord;
  A: PTestArray;
  Index: Integer;
  I: Integer;
  Count: Integer;
begin
  T1 := GetTickCount;
  GetMem(A, FArraySize * sizeof(Integer));
  T2 := GetTickCount;
  lblArrayCreate.Caption := IntToStr(T2 - T1);

  T1 := GetTickCount;
  for Count := 1 to 10000 do
    for Index := 1 to FArraySize do
      A^[Index] := Index;
  T2 := GetTickCount;
  lblArrayWrite.Caption := IntToStr(T2 - T1);

  T1 := GetTickCount;
  for Count := 1 to 10000 do
    for Index := 1 to FArraySize do
      I := A^[Index];
  T2 := GetTickCount;
  lblArrayRead.Caption := IntToStr(T2 - T1);

  T1 := GetTickCount;
  FreeMem(A, FArraySize * sizeof(Integer));
  T2 := GetTickCount;
  lblArrayDestroy.Caption := IntToStr(T2 - T1);
end;

procedure TForm1.TestVariant;
var
  T1, T2: DWord;
  Index: Integer;
  I: Integer;
  V: Variant;
  Count: Integer;
begin
  T1 := GetTickCount;
  V := VarArrayCreate([1, FArraySize], varInteger);
  T2 := GetTickCount;
  lblVariantCreate.Caption := IntToStr(T2 - T1);

  T1 := GetTickCount;
  for Count := 1 to 10000 do
    for Index := 1 to FArraySize do
      V[Index] := Index;
  T2 := GetTickCount;
  lblVariantWrite.Caption := IntToStr(T2 - T1);

  T1 := GetTickCount;
  for Count := 1 to 10000 do
    for Index := 1 to FArraySize do
      I := V[Index];
  T2 := GetTickCount;
  lblVariantRead.Caption := IntToStr(T2 - T1);

  T1 := GetTickCount;
  VarClear(V);
  T2 := GetTickCount;
  lblVariantDestroy.Caption := IntToStr(T2 - T1);
end;

procedure TForm1.TestLockedVariant;
var
  T1, T2: DWord;
  A: PTestArray;
  Index: Integer;
  I: Integer;
  V: Variant;
  Count: Integer;
begin
  T1 := GetTickCount;
  V := VarArrayCreate([1, FArraySize], varInteger);
  T2 := GetTickCount;
  lblLockedVariantCreate.Caption := IntToStr(T2 - T1);

  T1 := GetTickCount;
  A := VarArrayLock(V);
  T2 := GetTickCount;
  lblLockedVariantLock.Caption := IntToStr(T2 - T1);

  T1 := GetTickCount;
  for Count := 1 to 10000 do
    for Index := 1 to FArraySize do
      A^[Index] := Index;
  T2 := GetTickCount;
  lblLockedVariantWrite.Caption := IntToStr(T2 - T1);

  T1 := GetTickCount;
  for Count := 1 to 10000 do
    for Index := 1 to FArraySize do
      I := A^[Index];
  T2 := GetTickCount;
  lblLockedVariantRead.Caption := IntToStr(T2 - T1);

  T1 := GetTickCount;
  VarArrayUnlock(V);
  T2 := GetTickCount;
  lblLockedVariantUnlock.Caption := IntToStr(T2 - T1);

  T1 := GetTickCount;
  VarClear(V);
  T2 := GetTickCount;
  lblLockedVariantDestroy.Caption := IntToStr(T2 - T1);
end;

procedure TForm1.btnRunClick(Sender: TObject);
begin
  FArraySize := StrToInt(ecArraySize.Text);
  if (FArraySize < 2) or (FArraySize > 1000000) then begin
    ShowMessage('Please specify an array size between 2 and 1,000,000');
    exit;
  end;

  Screen.Cursor := crHourglass;
  try
    TestArray;
    TestVariant;
    TestLockedVariant;
  finally
    Screen.Cursor := crDefault;
  end;
end;

end.