FireMonkey消息机制

interface



uses

  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Classes, FMX.Forms,

  FMX.Platform.Win, FMX.Types, FMX.Layouts, FMX.Memo;



type

  TForm1 = class(TForm)

    Memo1: TMemo;

    procedure FormCreate(Sender: TObject);

    procedure FormDestroy(Sender: TObject);

  private

    FHwnd: HWND; // 保存窗口句柄

    FOldWndProc: LONG; // 保存原始的消息处理函数

  public

    function WndProc(HWND: HWND; Msg: UINT; wParam: wParam; lParam: lParam): LRESULT;

  end;



var

  Form1: TForm1;



implementation



{$R *.fmx}



function WindowProc(HWND: HWND; Msg: UINT; wParam: wParam; lParam: lParam): LRESULT; stdcall;

begin

  // 因为在通常开发时，需要访问窗口内部的方法或控件等

  // 为了方便起见，所以在这里做一个消息转发

  Result := Form1.WndProc(HWND, Msg, wParam, lParam);

end;



procedure TForm1.FormCreate(Sender: TObject);

begin

  // 获得主窗口句柄，在FMX框架下，Handle已经不是本窗口的句柄了，需要转换一下

  FHwnd := FmxHandleToHwnd(Handle);

  // 保存原始的WindowProc地址

  FOldWndProc := GetWindowLongPtr(FHwnd, GWL_WNDPROC);

  // 获得消息处理权

  SetWindowLongPtr(FHwnd, GWL_WNDPROC, NativeInt(@WindowProc));

end;



procedure TForm1.FormDestroy(Sender: TObject);

begin

  // 因为窗口销毁后无法再处理Windows传递来的消息，从而会发生内存访问错误

  // 所以在窗口销毁前要把消息处理权移交给原始的WindowProc

  SetWindowLongPtr(FHwnd, GWL_WNDPROC, FOldWndProc);

end;



function TForm1.WndProc(HWND: HWND; Msg: UINT; wParam: wParam; lParam: lParam): LRESULT;

begin

  Result := 0;

  // 这里测试处理鼠标滚轮消息

  if Msg = WM_MOUSEWHEEL then

  begin

    Memo1.Lines.Add('亲~!你使用了鼠标滚轮哦~!');

    Exit;

  end;

  Result := CallWindowProc(Ptr(FOldWndProc), HWND, Msg, wParam, lParam);

end;



end.