unit ScWndProc;
interface
uses Forms, Messages;
const
DDGM_FOOMSG = WM_USER; //自定义消息
implementation
uses windows,sysutils,Dialogs;
var
WProc : Pointer;
function NewWndProc(handle: hWnd; msg,wParam,lParam: LongInt): LongInt ;
stdcall;
begin
if msg = DDGM_FOOMSG then
ShowMessage(Format('收到自定义消息 $%x',[msg]));
result := CallWindowProc(WProc,handle, msg,wParam,lParam);
end;
initialization
WProc := Pointer(SetWindowLong(application.Handle,GWL_WNDPROC
,integer(@NewWndProc)));
end.
unit UnitSendVsPost;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls;
type
TFrmSendPostMsg = class(TForm)
btnSendMessage: TButton;
btnPostMessage: TButton;
procedure btnSendMessageClick(Sender: TObject);
procedure btnPostMessageClick(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
private
{ Private declarations }
OldWndProc : Pointer;
WndProcPtr : Pointer;
procedure WndMethod(var msg: TMessage);
procedure HandleAppMessage(var msg : TMsg; var handled : boolean);
public
{ Public declarations }
end;
var
FrmSendPostMsg: TFrmSendPostMsg;
implementation
{$R *.dfm}
uses
ScWndProc;
procedure TFrmSendPostMsg.WndMethod(var msg: TMessage);
begin
if msg.Msg = DDGM_FOOMSG then
begin
ShowMessage(Format('Message seen by WndMethod! value is: $%x',[msg.Msg]));
with msg do
result := CallWindowProc(OldWndProc,Application.Handle,msg,WParam,LParam);
end;
end;
procedure TFrmSendPostMsg.HandleAppMessage(var msg : TMsg; var handled : boolean);
begin
if msg.message = DDGM_FOOMSG then
begin
ShowMessage(Format('Message seen by OnMessage! value is: $%x',[msg.message]));
//handled := true;
end;
end;
procedure TFrmSendPostMsg.btnSendMessageClick(Sender: TObject);
begin
//发送消息
sendmessage(application.Handle,DDGM_FOOMSG,0,0);
end;
procedure TFrmSendPostMsg.btnPostMessageClick(Sender: TObject);
begin
postmessage(application.Handle,DDGM_FOOMSG,0,0);
end;
procedure TFrmSendPostMsg.FormCreate(Sender: TObject);
begin
application.OnMessage := HandleAppMessage; // set OnMessage handler
WndProcPtr := MakeObjectInstance(WndMethod);
OldWndProc := Pointer(SetWindowLong(Application.Handle,GWL_WNDPROC,Integer(WndProcPtr)));
end;
procedure TFrmSendPostMsg.FormDestroy(Sender: TObject);
begin
SetWindowLong(Application.Handle,GWL_WNDPROC,LongInt(OldWndProc));
FreeObjectInstance(WndProcPtr);
end;
end.
unit UnitHook;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls;
type
TFrmHookWin = class(TForm)
lstMsg: TListBox;
btnSendMsg: TButton;
procedure btnSendMsgClick(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
private
{ Private declarations }
function AppWindowHook(var message: TMessage): boolean;
public
{ Public declarations }
end;
var
FrmHookWin: TFrmHookWin;
implementation
{$R *.dfm}
function TFrmHookWin.AppWindowHook(var message: TMessage): boolean;
const
strLog = 'MsgID: $%x, WParam: $%x, LParam: $%x';
begin
Result := true;
with message do
lstMsg.Items.Add(Format(strLog,[Msg,WParam,LParam]));
end;
procedure TFrmHookWin.btnSendMsgClick(Sender: TObject);
begin
SendMessage(application.Handle,WM_NULL,0,0);
end;
procedure TFrmHookWin.FormCreate(Sender: TObject);
begin
Application.HookMainWindow(self.AppWindowHook);
end;
procedure TFrmHookWin.FormDestroy(Sender: TObject);
begin
application.UnhookMainWindow(self.AppWindowHook);
end;
end.
Delphi 自定义窗口过程WinProc
点赞
收藏