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.

原文地址：https://www.cnblogs.com/YiShen/p/9725165.html