Delphi 自定义窗口过程WinProc
Posted yishen
tags:
篇首语:本文由小常识网(cha138.com)小编为大家整理,主要介绍了Delphi 自定义窗口过程WinProc相关的知识,希望对你有一定的参考价值。
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的主要内容,如果未能解决你的问题,请参考以下文章