Delphi 自定义窗口过程WinProc

1unit ScWndProc;
2 
3interface
4uses Forms, Messages;
5 
6const
7    DDGM_FOOMSG = WM_USER;  //自定义消息
8 
9implementation
10 
11uses windows,sysutils,Dialogs;
12 
13var
14    WProc : Pointer;
15 
16function NewWndProc(handle: hWnd; msg,wParam,lParam: LongInt): LongInt ;
17stdcall;
18begin
19    if msg = DDGM_FOOMSG then
20        ShowMessage(Format('收到自定义消息 $%x',[msg]));
21 
22    result := CallWindowProc(WProc,handle, msg,wParam,lParam);
23end;
24 
25initialization
26    WProc := Pointer(SetWindowLong(application.Handle,GWL_WNDPROC
27        ,integer(@NewWndProc)));                                            
28end.
29
30unit UnitSendVsPost;
31 
32interface
33 
34uses
35  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
36  Dialogs, StdCtrls;
37 
38type
39  TFrmSendPostMsg = class(TForm)
40    btnSendMessage: TButton;
41    btnPostMessage: TButton;
42    procedure btnSendMessageClick(Sender: TObject);
43    procedure btnPostMessageClick(Sender: TObject);
44    procedure FormCreate(Sender: TObject);
45    procedure FormDestroy(Sender: TObject);
46  private
47    { Private declarations }
48    OldWndProc : Pointer;
49    WndProcPtr : Pointer;
50    procedure WndMethod(var msg: TMessage);
51    procedure HandleAppMessage(var msg : TMsg; var handled : boolean);
52  public
53    { Public declarations }
54  end;
55 
56var
57  FrmSendPostMsg: TFrmSendPostMsg;
58 
59implementation
60 
61{$R *.dfm}
62uses
63    ScWndProc;
64 
65procedure TFrmSendPostMsg.WndMethod(var msg: TMessage);
66begin
67     if msg.Msg = DDGM_FOOMSG  then
68    begin
69        ShowMessage(Format('Message seen by WndMethod! value is: $%x',[msg.Msg]));
70        with msg do
71            result := CallWindowProc(OldWndProc,Application.Handle,msg,WParam,LParam);
72    end;
73end;
74 
75procedure TFrmSendPostMsg.HandleAppMessage(var msg : TMsg; var handled : boolean);
76begin
77    if msg.message = DDGM_FOOMSG  then
78    begin
79        ShowMessage(Format('Message seen by OnMessage! value is: $%x',[msg.message]));
80        //handled := true;
81    end;
82end;
83 
84procedure TFrmSendPostMsg.btnSendMessageClick(Sender: TObject);
85begin
86    //发送消息
87    sendmessage(application.Handle,DDGM_FOOMSG,0,0);
88end;
89 
90procedure TFrmSendPostMsg.btnPostMessageClick(Sender: TObject);
91begin
92     postmessage(application.Handle,DDGM_FOOMSG,0,0);
93end;
94 
95procedure TFrmSendPostMsg.FormCreate(Sender: TObject);
96begin
97    application.OnMessage := HandleAppMessage;        // set OnMessage handler
98    WndProcPtr := MakeObjectInstance(WndMethod);
99    OldWndProc := Pointer(SetWindowLong(Application.Handle,GWL_WNDPROC,Integer(WndProcPtr)));
100end;
101 
102procedure TFrmSendPostMsg.FormDestroy(Sender: TObject);
103begin
104    SetWindowLong(Application.Handle,GWL_WNDPROC,LongInt(OldWndProc));
105    FreeObjectInstance(WndProcPtr);
106end;
107 
108end.
109
110unit UnitHook;
111 
112interface
113 
114uses
115  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
116  Dialogs, StdCtrls;
117 
118type
119  TFrmHookWin = class(TForm)
120    lstMsg: TListBox;
121    btnSendMsg: TButton;
122    procedure btnSendMsgClick(Sender: TObject);
123    procedure FormCreate(Sender: TObject);
124    procedure FormDestroy(Sender: TObject);
125  private
126    { Private declarations }
127    function AppWindowHook(var message: TMessage): boolean;
128  public
129    { Public declarations }
130  end;
131 
132var
133  FrmHookWin: TFrmHookWin;
134 
135implementation
136 
137{$R *.dfm}
138 
139function TFrmHookWin.AppWindowHook(var message: TMessage): boolean;
140const
141    strLog = 'MsgID: $%x, WParam: $%x, LParam: $%x';
142begin
143    Result := true;
144    with message do
145        lstMsg.Items.Add(Format(strLog,[Msg,WParam,LParam]));
146end;
147procedure TFrmHookWin.btnSendMsgClick(Sender: TObject);
148begin
149    SendMessage(application.Handle,WM_NULL,0,0);
150end;
151 
152procedure TFrmHookWin.FormCreate(Sender: TObject);
153begin
154     Application.HookMainWindow(self.AppWindowHook);
155end;
156 
157procedure TFrmHookWin.FormDestroy(Sender: TObject);
158begin
159     application.UnhookMainWindow(self.AppWindowHook);
160end;
161 
162end.