sendmsttimeoutgetu.pas

Delphi Win32核心API参考光盘

unit SendMstTimeoutGetU;

interface

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

type
  TForm1 = class(TForm)
    Label1: TLabel;
    ProgressBar1: TProgressBar;
    Label2: TLabel;
    procedure FormCreate(Sender: TObject);
  private
    { Private declarations }
    procedure DefaultHandler(var Msg); override;
  public
    { Public declarations }
  end;

var
  Form1: TForm1;
  UserMessage: UINT;  // holds our user defined message identifier

implementation

{$R *.DFM}

procedure TForm1.DefaultHandler(var Msg);
var
  iLoop: Integer;  // general loop counter
begin
  {process message normally}
  inherited DefaultHandler(Msg);

  {if this is our user defined message...}
  if TMessage(Msg).Msg=UserMessage then
  begin
    {...display some user interface objects}
    ProgressBar1.Visible := TRUE;
    Label2.Visible := TRUE;
    Form1.Repaint;

    {animate the progress bar for a short time}
    for iLoop := 0 to 100 do
    begin
      ProgressBar1.Position := iLoop;
      Sleep(10);
    end;

    {turn off the user interface objects}
    ProgressBar1.Visible := FALSE;
    Label2.Visible := FALSE;

    {indicate that the message was handled}
    TMessage(Msg).Result := 1;
  end;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  {register the user defined Windows message}
  UserMessage := RegisterWindowMessage('SendMessageTimout Test Message');
end;

end.