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,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,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,0,0);
end;
 
procedure TFrmSendPostMsg.FormCreate(Sender: TObject);
begin
    application.OnMessage := HandleAppMessage;        // set OnMessage handler
    WndProcPtr := MakeObjectInstance(WndMethod);
    OldWndProc := Pointer(SetWindowLong(Application.Handle,Integer(WndProcPtr)));
end;
 
procedure TFrmSendPostMsg.FormDestroy(Sender: TObject);
begin
    SetWindowLong(Application.Handle,LongInt(OldWndProc));
    FreeObjectInstance(WndProcPtr);
end;
 
end.

unit UnitHook;
 
interface
 
uses
  Windows,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,LParam]));
end;
procedure TFrmHookWin.btnSendMsgClick(Sender: TObject);
begin
    SendMessage(application.Handle,WM_NULL,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.