【Delphi】在主Form以外的Unit中拦截主Form的消息

最新推荐文章于 2026-06-22 06:40:43 发布

原创最新推荐文章于 2026-06-22 06:40:43 发布 · 354 阅读

0 ·

本内容遵循CC 4.0 BY-SA版权协议

拦截消息同时被 2 个专栏收录

1 篇文章

订阅专栏

Hook

1 篇文章

订阅专栏

本文介绍了一个使用Delphi实现的窗口钩子技术示例。通过创建并应用窗口钩子，可以监听主窗体的移动和调整大小事件。文章展示了如何设置钩子函数、添加和移除钩子，并提供了完整的代码实现。

unit Unit1;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants,
  System.Classes, Vcl.Graphics, Vcl.Controls, Vcl.Forms, Vcl.Dialogs,
  Vcl.StdCtrls,
  Unit2, Unit3;

type
  TForm1 = class(TForm)
    procedure FormShow(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
  private
    Test2: TTest2;
    Test3: TTest3;
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.FormShow(Sender: TObject);
begin
  Test2 := TTest2.Create;
  Test3 := TTest3.Create;
end;

procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  Test2.Free;
  Test3.Free;
end;

end.

unit Unit2;

interface

uses Winapi.Messages, Vcl.Dialogs,
     uMainFormHooks;

type
  TTest2 = class(TObject)
  private
    function HookFunc(var Msg: TMessage): Boolean;
  public
    constructor Create;
    destructor Destroy; override;
  end;

implementation

function TTest2.HookFunc(var Msg: TMessage): Boolean;
begin
  if Msg.Msg = WM_MOVE then
  begin
    ShowMessage('MainForm is Moving.')
  end;
  Result := False;
end;

constructor TTest2.Create;
begin
  inherited;
  MainFormHooks.Add(HookFunc);
end;

destructor TTest2.Destroy;
begin
  MainFormHooks.Remove(HookFunc);
  inherited;
end;


end.

unit Unit3;

interface

uses Winapi.Messages, Vcl.Dialogs,
     uMainFormHooks;

type
  TTest3 = class(TObject)
  private
    function HookFunc(var Msg: TMessage): Boolean;
  public
    constructor Create;
    destructor Destroy; override;
  end;

implementation

function TTest3.HookFunc(var Msg: TMessage): Boolean;
begin
  if Msg.Msg = WM_SIZE then
  begin
    ShowMessage('MainForm is Resizing.')
  end;
  Result := False;
end;

constructor TTest3.Create;
begin
  inherited;
  MainFormHooks.Add(HookFunc);
end;

destructor TTest3.Destroy;
begin
  MainFormHooks.Remove(HookFunc);
  inherited;
end;

end.

unit uMainFormHooks;

interface

uses Vcl.Forms, Vcl.Controls, Winapi.Messages, System.SysUtils,
     Generics.Collections, Winapi.Windows;

type
  TMainFormHooks = class(TList<TWindowHook>)
  private
    Hooked: Boolean;
    MainForm: TForm;
    MainProc: TWndMethod;
    procedure NewProc(var Msg: TMessage);
    function  AppHook(var Msg: TMessage): Boolean;
  public
    procedure Add   (WindowHook: TWindowHook);
    procedure Remove(WindowHook: TWindowHook);
    constructor Create;
    destructor Destroy; override;
  end;

var
  MainFormHooks: TMainFormHooks;

implementation

constructor TMainFormHooks.Create;
begin
  if MainFormHooks <> nil then
    MainFormHooks.Free;  //单实例类

  inherited;
  Hooked   := False;
  MainProc := nil;
  Application.HookMainWindow(AppHook);
end;

destructor TMainFormHooks.Destroy;
begin
  MainForm.WindowProc := MainProc;
  inherited;
  MainFormHooks := nil;
end;

procedure TMainFormHooks.Add(WindowHook: TWindowHook);
begin
  if (IndexOf(WindowHook) = -1) then
    inherited Add(WindowHook);

  if (not Hooked) and (Count > 0) and (MainForm <> nil) then
  begin
    Hooked := True;
    MainForm.WindowProc := NewProc;
  end;
end;

procedure TMainFormHooks.Remove(WindowHook: TWindowHook);
begin
  inherited Remove(WindowHook);

  if Hooked and ((Count = 0) or (MainForm = nil)) then
  begin
    Hooked := False;
    MainForm.WindowProc := MainProc;
  end;
end;

procedure TMainFormHooks.NewProc(var Msg: TMessage);
var
  I: Integer;
begin
  for I := Count-1 downto 0 do
  begin
    if Self[I](Msg) then Exit;
  end;

  MainProc(Msg);
end;

function TMainFormHooks.AppHook(var Msg: TMessage): Boolean;
begin
  if Msg.Msg = WM_ACTIVATEAPP then
  begin
    Application.UnHookMainWindow(AppHook);
    MainForm := Application.MainForm;
    MainProc := MainForm.WindowProc;
    if (not Hooked) and (Count > 0) then
    begin
      Hooked := True;
      MainForm.WindowProc := NewProc;
    end;
  end;

  Result := False;
end;

initialization
  MainFormHooks := TMainFormHooks.Create;

finalization
  if MainFormHooks <> nil then
    MainFormHooks.Free;

end.