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发送到消息不经过消息泵,因此直接调用过程函数(先执行新的过程函数,再继续传递给旧的)