对发给Application.Handle消息的三次执行(拦截)消息的过程

unit Main;

interface

uses
  SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
  Forms, Dialogs, StdCtrls;

type
  TMainForm = class(TForm)
    SendBtn: TButton;
    PostBtn: TButton;
    procedure SendBtnClick(Sender: TObject);
    procedure PostBtnClick(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
  private
    OldWndProc: Pointer;
    WndProcPtr: Pointer;
    procedure WndMethod(var Msg: TMessage);
    procedure HandleAppMessage(var Msg: TMsg; var Handled: Boolean);
  end;

var
  MainForm: TMainForm;

implementation

{$R *.DFM}

uses ScWndPrc;

procedure TMainForm.SendBtnClick(Sender: TObject);
begin
  SendMessage(Application.Handle, WM_USER, 0, 0);
end;

procedure TMainForm.PostBtnClick(Sender: TObject);
begin
  PostMessage(Application.Handle, WM_USER, 0, 0);
end;

procedure TMainForm.HandleAppMessage(var Msg: TMsg; var Handled: Boolean);
begin
  if Msg.Message = WM_USER then
    ShowMessage(Format('Message seen by OnMessage! Value is: $%x', [Msg.Message]));
end;

procedure TMainForm.WndMethod(var Msg: TMessage);
begin
  if Msg.Msg = WM_USER then // 第二处处理（新的过程函数）
    ShowMessage(Format('Message seen by WndMethod! Value is: $%x', [Msg.Msg]));
  with Msg do
    Result := CallWindowProc(OldWndProc, Application.Handle, Msg, wParam, lParam); // 第三处处理（旧的过程函数）
end;

procedure TMainForm.FormCreate(Sender: TObject);
begin
  Application.OnMessage := HandleAppMessage;     // 第一处处理（先过OnMessage这关）
  WndProcPtr := MakeObjectInstance(WndMethod);   // make window proc
  { Set window procedure of application window. }
  OldWndProc := Pointer(SetWindowLong(Application.Handle, GWL_WNDPROC, Integer(WndProcPtr)));
end;

procedure TMainForm.FormDestroy(Sender: TObject);
begin
  { Restore old window procedure for Application window }
  SetWindowLong(Application.Handle, GWL_WNDPROC, Longint(OldWndProc));
  { Free our user-created window procedure }
  FreeObjectInstance(WndProcPtr);
end;

end.


unit Scwndprc;

interface

uses Forms, Messages;

implementation

uses Windows, SysUtils, Dialogs;

var
  WProc: Pointer;

function NewWndProc(Handle: hWnd; Msg, wParam, lParam: Longint): Longint;
  stdcall;
{ This is a Win32 API-level window procedure. It handles the messages }
{ received by the Application window. }
begin
  if Msg = WM_USER then
    { If it's our user-defined message, then alert the user. }
    ShowMessage(Format('Message seen by WndProc! Value is: $%x', [Msg]));
  { Pass message on to old window procedure }
  Result := CallWindowProc(WProc, Handle, Msg, wParam, lParam);
end;

initialization
  { Set window procedure of Application window. }
  WProc := Pointer(SetWindowLong(Application.Handle, gwl_WndProc,
    Integer(@NewWndProc)));
end.

对发给Application.Handle消息的总结：
1. 先过Application.OnMessage这关
2. 过新的过程函数这关
3. 还可继续传递给旧的过程函数
其中SendMessage发送到消息不经过消息泵，因此直接调用过程函数（先执行新的过程函数，再继续传递给旧的）