callwindowprocu.pas

来自「Delphi Win32核心API参考光盘源码 本书包含了常用的Windows」· PAS 代码 · 共 86 行

unit CallWindowProcU;

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);
    procedure FormDestroy(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

  {the prototype for the new window procedure}
  function NewWindowProc(TheWindow: HWND; Msg: Integer; wParam: WPARAM;
                         lParam: LPARAM): Longint; stdcall;

var
  Form1: TForm1;
  UserMessage: UINT;         // holds a user defined message identifier
  OldWindowProc: TFNWndProc; // holds a pointer to the previous window procedure

implementation

{$R *.DFM}

function NewWindowProc(TheWindow: HWND; Msg: Integer; wParam: WPARAM; lParam: LPARAM): Longint;
var
  iLoop: Integer;         // a general loop counter
begin
  {if the user defined message has been received...}
  if Msg=UserMessage then
  begin
    {...turn on some user interface elements}
    Form1.ProgressBar1.Visible := TRUE;
    Form1.Label2.Visible := TRUE;
    Form1.Repaint;

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

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

    {the message was handled, so return a one}
    Result := 1;
  end
  else
    {any other message must be passed to the previous window procedure}
    Result := CallWindowProc(OldWindowProc, TheWindow, Msg, wParam, lParam);
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  {register a user defined message}
  UserMessage := RegisterWindowMessage('CallWindowProc Test Message');

  {subclass this window.  replace the window procedure with one of
   ours.  this window procedure will receive messages before the
   previous one, allowing us to intercept and process any message
   before the rest of the application ever sees it.}
  OldWindowProc := TFNWndProc(SetWindowLong(Form1.Handle, GWL_WNDPROC,
                              Longint(@NewWindowProc)));
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
  {reset the window procedure to the previous one}
  SetWindowLong(Form1.Handle, GWL_WNDPROC, Longint(OldWindowProc));
end;

end.