fmmain.pas

多数代码可以直接在Delphi6和Delphi7环境下运行。部分涉及.NET技术内容的代码

unit fmMain;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, Buttons, Grids, ExtCtrls, uSendMessageThread;

type
  TForm1 = class(TForm)
    StringGrid1: TStringGrid;
    btnDefaultHandler: TBitBtn;
    btnReset: TBitBtn;
    btnAllMessages: TBitBtn;
    BitBtn1: TBitBtn;
    BitBtn2: TBitBtn;
    btnTimer: TBitBtn;
    Timer1: TTimer;
    btnFlowTime: TBitBtn;
    btnTriiger: TBitBtn;
    procedure btnResetClick(Sender: TObject);
    procedure btnDefaultHandlerClick(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure BitBtn2Click(Sender: TObject);
    procedure btnAllMessagesClick(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure btnTimerClick(Sender: TObject);
    procedure btnFlowTimeClick(Sender: TObject);
    procedure FormDblClick(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
    procedure btnTriigerClick(Sender: TObject);
    procedure FormMouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure StringGrid1MouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
  private
    { Private declarations }
    bDefault : Boolean;
    bCutAllMessage : Boolean;
    bCountAllMsgs : Boolean;
    lMsgs : Longint;
    lAllMsgs : Longint;
    lNothing : Longint;
    lStart : Longint;
    lEnd : Longint;
    iRow : Integer;
    aMsgList : TStringList;
    aMT : TSendMessage;
    iTotalMsgs : Integer;

    procedure ResetAllFlags;
    function GetMsgCount(const iCount : Integer) : String;
  public
    { Public declarations }
    procedure Dispatch(var Message); override;
    procedure DefaultHandler(var Message); override;
    procedure WndProc(var Message: TMessage); override;
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.btnResetClick(Sender: TObject);
begin
  ResetAllFlags;
end;

procedure TForm1.btnDefaultHandlerClick(Sender: TObject);
begin
  bDefault := True;
end;

procedure TForm1.DefaultHandler(var Message);
var
  aMsg : TMessage;
begin
  inherited;

  if (bDefault) then
  begin
    aMsg := TMessage(Message);
    Self.StringGrid1.Cells[0, iRow] := IntToStr(iRow);
    Self.StringGrid1.Cells[1, iRow] := IntToStr(aMsg.Msg);
    Inc(iRow);
  end;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  ResetAllFlags;
  aMsgList := TStringList.Create;
end;

procedure TForm1.Dispatch(var Message);
var
  aMsg : TMessage;
begin
  if (not bCutAllMessage) then
    inherited;

  if Assigned(aMsgList) then
  begin
    aMsg := TMessage(Message);
    aMsgList.Add(IntToStr(aMsg.Msg));
  end;
  Inc(lMsgs);
end;

procedure TForm1.BitBtn2Click(Sender: TObject);
begin
  if MessageDlg('这将会停止此范例程序回应窗口消息, 确定继续执行?',
    mtConfirmation, [mbYes, mbNo], 0) = mrYes then
  begin
    bCutAllMessage := True;
  end;
end;

procedure TForm1.ResetAllFlags;
begin
  bDefault := False;
  bCutAllMessage := False;
  bCountAllMsgs := False;
  lMsgs := 0;
  lAllMsgs := 0;
  iRow := 1;
end;

function TForm1.GetMsgCount(const iCount: Integer): String;
begin
  Result := '目前总共消息 : ' + IntToStr(iCount);
end;

procedure TForm1.btnAllMessagesClick(Sender: TObject);
var
  iCount : Integer;
begin
  Self.Caption := GetMsgCount(lMsgs);
  for iCount := 0 to aMsgList.Count - 1 do
  begin
    Self.StringGrid1.Cells[0, iCount + 1] := IntToStr(iCount+1);
    Self.StringGrid1.Cells[1, iCount + 1] := aMsgList.Strings[iCount];
  end;
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
  FreeAndNil(aMsgList);
end;

const TESTLOOP = 100;

procedure TForm1.btnTimerClick(Sender: TObject);
begin
  aMT := TSendMessage.Create(True);
  lAllMsgs := 0;
  Self.Timer1.Enabled := True;
  aMT.Resume;
end;

procedure TForm1.WndProc(var Message: TMessage);
begin
  inherited;
  lStart := GetTickCount;

  if (bCountAllMsgs) then
    Inc(lAllMsgs);
end;

procedure TForm1.btnFlowTimeClick(Sender: TObject);
begin
  lEnd := GetTickCount;
  Self.Caption := '消息流动时间 : ' + IntToStr((lEnd - lStart));
end;

procedure TForm1.FormDblClick(Sender: TObject);
begin
  lEnd := GetTickCount;
  Self.Caption := '消息流动时间 : ' + IntToStr((lEnd - lStart));
end;

procedure TForm1.Timer1Timer(Sender: TObject);
begin
  aMT.Terminate;
  Self.Timer1.Enabled := False;
  FreeAndNil(aMT);
  Self.Caption := '平均1秒处理 : ' + IntToStr(lAllMsgs) + ' 个消息';
  Inc(iTotalMsgs, lAllMsgs);
end;

procedure TForm1.btnTriigerClick(Sender: TObject);
begin
  Inc(lAllMsgs);
end;

procedure TForm1.FormMouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  Inc(lNothing);
end;

procedure TForm1.StringGrid1MouseDown(Sender: TObject;
  Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
  Inc(lNothing);
end;

end.