Delphi FMX下WndProc Hook

因为FMX是一套跨平台的组件,所以把消息过程移除掉了,不能愉快的像VCL那样拦截消息。

现在提供一个简单拦截消息过程的方法:

开源地址: https://github.com/ying32/FMXWndProcHook

  • 引用单元 FMX.WndProcHook

里面提供了两种方式,一是继承自TWndProcForm或者使用TWndProcHook对象。

下面是继承自TWndProcForm的演示,完成后就可以像VCL一样使用拦截消息了(注:需要在Form的DoShow中调用Hook,如果在OnCreate中拦截后会被替换掉消息,造成消息HOOK失效。)。


unit Unit23;

interface

uses
  Winapi.Windows, Winapi.Messages,
  System.SysUtils, System.Types, System.UITypes, System.Classes, System.Variants,
  FMX.Types, FMX.Controls, FMX.Forms, FMX.Graphics, FMX.Dialogs, FMX.WndProcHook,
  FMX.Controls.Presentation, FMX.StdCtrls;

type
  TForm23 = class(TWndProcForm)
    Button1: TButton;
    procedure FormMouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Single);
    procedure Button1Click(Sender: TObject);
  private
    { Private declarations }
  protected
    procedure WndProc(var Message: TMessage); override;
  public
    { Public declarations }
    procedure WMMove(var msg: TWMMove); message WM_MOVE;
    procedure WMLButtonDown(var msg: TWMLButtonDown); message WM_LBUTTONDOWN;
  end;

var
  Form23: TForm23;

implementation

{$R *.fmx}

procedure TForm23.Button1Click(Sender: TObject);
begin
  Perform(WM_SYSCOMMAND, SC_MINIMIZE, 0);
end;

procedure TForm23.FormMouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Single);
begin
  Log.d('mousedown: x=%f, y=%f', [x, y]);
end;

procedure TForm23.WMLButtonDown(var msg: TWMLButtonDown);
begin
  Log.d('鼠标按下: x=%d, y=%d', [Msg.XPos, msg.YPos]);
//  Msg.Result := 1;  // 拦截消息,这样 FormMouseDown 就收不到这个消息了
end;

procedure TForm23.WMMove(var msg: TWMMove);
begin
  msg.Result := 1;
  Log.d('收到移动的消息');
end;

procedure TForm23.WndProc(var Message: TMessage);
begin
  inherited;
  if Message.Msg = WM_LBUTTONDOWN then
  begin
    Log.d('WndProc 鼠标按下: x=%d, y=%d', [TWMLButtonDown(Message).XPos, TWMLButtonDown(Message).YPos]);
    //Message.Result := 1;  // 拦截消息, WMLButtonDown  FormMouseDown 将都收不到消息
  end;
end;

end.


你可能感兴趣的:(Delphi,FireMonkey)