FMX -Tray图标消息处理

Question

我在用FMX (XE3，Windows)设置托盘图标时遇到了问题。我正在使用相同的代码，可以在无数线程中找到，但我没有得到信息处理的图标工作。

为了发挥作用，我创建了一个testapp，它在TrayIcon中设置FormCreate数据，并使用按钮创建它。它将显示正确的图标和正确的工具提示，TrayMessage过程将永远不会被调用。

unit Unit2;

interface

uses
  System.SysUtils, System.Types, System.UITypes, System.Rtti, System.Classes,
  System.Variants, FMX.Types, FMX.Controls, FMX.Forms, FMX.Dialogs, Messages,
  Windows, ShellAPI, FMX.Platform.Win;

const
  WM_ICONTRAY = WM_USER + 1;

type
  TForm2 = class(TForm)
    Button1: TButton;
    procedure FormCreate(Sender: TObject);
    procedure Button1Click(Sender: TObject);
  private
    TrayIconData: TNotifyIconData;
    procedure TrayMessage(var Msg: TMessage); message WM_ICONTRAY;
  end;

var
  Form2: TForm2;

implementation

{$R *.fmx}

procedure TForm2.Button1Click(Sender: TObject);
begin
  Shell_NotifyIcon(NIM_ADD, @TrayIconData);
end;

procedure TForm2.FormCreate(Sender: TObject);
begin
  with TrayIconData do
  begin
    cbSize := SizeOf;
    Wnd := FmxHandleToHWND(self.Handle);
    uID := 0;
    uFlags := NIF_MESSAGE + NIF_ICON + NIF_TIP;
    uCallbackMessage := WM_ICONTRAY;
    hIcon := GetClassLong(FmxHandleToHWND(self.Handle), GCL_HICONSM);
    StrPCopy(szTip, 'testapp');
  end;
end;

procedure TForm2.TrayMessage(var Msg: TMessage);
begin
  case Msg.lParam of
    WM_LBUTTONDOWN: ShowMessage('LBUTTON');
    WM_RBUTTONDOWN: ShowMessage('RBUTTON');
  end;
end;

end.

我已经用VCL创建了相同的场景，并且它的工作方式与预期的一样。唯一的区别是直接使用Form2.Handle而不是FMX转换(以及Application.Handle加载图标数据，但这不是FMX中问题的一部分)。谁能给我指明正确的方向？

Answer 1

与VCL不同，FireMonkey不向FMX控件发送原始窗口消息以进行自定义处理(这将达到跨平台框架的目的)。FireMonkey有一个在FMX.Platform.Win单元中实现的WndProc()函数，用于FireMonkey创建的所有HWND窗口。该实现处理它需要处理的某些窗口消息，相应地触发各种控制方法(WMPaint()、KeyUp/Down()、MouseUp/Down()等)，然后直接将未处理的消息传递给DefWindowProc()进行操作系统处理，而不让控件看到消息。

因此，要获得对原始消息的访问权限的唯一方法是：

1. 创建自己的窗口，例如直接使用AllocateHWnd()或CreateWindow/Ex()。
2. 直接通过HWND连接到FireMonkey的Get/SetWindowLong/Ptr()窗口。由于FireMonkey是一个跨平台的框架，而HWND窗口是一个特定于平台的实现细节，所以我建议避免使用这种方法。
3. 通过SetWindowsHookEx()使用特定于线程的消息钩子.通过使它们特定于线程，您不必编写DLL来实现钩子.

在这种特殊情况下，#1是您的最佳选择。托盘图标是Windows特有的特性，所以您确实应该使用与FireMonkey无关的特定于Windows的代码来处理它们。您可以使用AllocateHWnd()来使用表单类(或任何类)的方法作为接收托盘消息的WndProc()，同时仍然允许表单类处理它们。例如：

type
  TForm2 = class(TForm)
    Button1: TButton;
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure Button1Click(Sender: TObject);
  private
    {$IFDEF MSWINDOWS}
    TrayWnd: HWND;
    TrayIconData: TNotifyIconData;
    TrayIconAdded: Boolean;
    procedure TrayWndProc(var Message: TMessage);
    {$ENDIF}
  public
    { Public declarations }
  end;

​

{$IFDEF MSWINDOWS}
const
  WM_ICONTRAY = WM_USER + 1;
{$ENDIF}

procedure TForm2.FormCreate(Sender: TObject);
begin
  {$IFDEF MSWINDOWS}
  TrayWnd := AllocateHWnd(TrayWndProc);
  with TrayIconData do
  begin
    cbSize := SizeOf(TrayIconData);
    Wnd := TrayWnd;
    uID := 1;
    uFlags := NIF_MESSAGE or NIF_ICON or NIF_TIP;
    uCallbackMessage := WM_ICONTRAY;
    hIcon := ...
    StrPCopy(szTip, 'testapp');
  end;
  {$ENDIF}
end;

procedure TForm2.FormDestroy(Sender: TObject);
begin
  {$IFDEF MSWINDOWS}
  if TrayIconAdded then
    Shell_NotifyIcon(NIM_DELETE, @TrayIconData);
  DeallocateHWnd(TrayWnd);
  {$ENDIF}
end;

procedure TForm2.Button1Click(Sender: TObject);
begin
  {$IFDEF MSWINDOWS}
  if not TrayIconAdded then
    TrayIconAdded := Shell_NotifyIcon(NIM_ADD, @TrayIconData);
  {$ENDIF}
end;

{$IFDEF MSWINDOWS}
procedure TForm2.TrayWndProc(var Message: TMessage);
begin
  if Message.MSG = WM_ICONTRAY then
  begin
     ...
  else
    Message.Result := DefWindowProc(TrayWnd, Message.Msg, Message.WParam, Message.LParam);
end;
{$ENDIF}

Answer 2

要处理FMX窗体上的windows消息，可以使用WndProc和SetWindowLong函数覆盖表单的SetWindowLong。

试试看这个样本

uses
  System.SysUtils, System.Types, System.UITypes, System.Classes, System.Variants,
  FMX.Types, FMX.Graphics, FMX.Controls, FMX.Forms, FMX.Dialogs, FMX.StdCtrls,  Winapi.Messages,
  Winapi.Windows,  Winapi.ShellAPI, FMX.Platform.Win;


const
  WM_ICONTRAY = WM_USER + 1;

type
  TForm14 = class(TForm)
    Button1: TButton;
    procedure FormCreate(Sender: TObject);
    procedure Button1Click(Sender: TObject);
  private
    OrgWndProc: Pointer;
    NewWndProc: Pointer;
    TrayIconData: TNotifyIconData;
    procedure _WndProc(var Message: TMessage);
  public
    { Public declarations }
  end;

var
  Form14: TForm14;

implementation


{$R *.fmx}

procedure TForm14.Button1Click(Sender: TObject);
begin
  Shell_NotifyIcon(NIM_ADD, @TrayIconData);
end;


procedure TForm14._WndProc(var Message: TMessage);
begin
  if Message.MSG=WM_ICONTRAY then
  begin
     case Message.LParam of
       WM_LBUTTONDOWN: ShowMessage('LBUTTON');
       WM_RBUTTONDOWN: ShowMessage('RBUTTON');
     else
      Message.Result:=CallWindowProc(OrgWndProc, FmxHandleToHWND(Self.Handle), Message.MSG, Message.WParam, Message.LParam);
     end;
  end
  else
  Message.Result:=CallWindowProc(OrgWndProc, FmxHandleToHWND(Self.Handle), Message.MSG, Message.WParam, Message.LParam);
end;


procedure TForm14.FormCreate(Sender: TObject);
var
  LInstance : Pointer;
begin
  //get the current WndProc
  OrgWndProc:= Pointer(GetWindowLong(FmxHandleToHWND(Self.Handle), GWL_WNDPROC));
  //Convert the class method to a Pointer
  LInstance:=MakeObjectInstance(_WndProc);
  //set the new WndProc
  NewWndProc:= Pointer(SetWindowLong(FmxHandleToHWND(Self.Handle), GWL_WNDPROC, IntPtr(LInstance)));

  with TrayIconData do
  begin
    cbSize := SizeOf;
    Wnd := FmxHandleToHWND(self.Handle);
    uID := 0;
    uFlags := NIF_MESSAGE + NIF_ICON + NIF_TIP;
    uCallbackMessage := WM_ICONTRAY;
    hIcon := GetClassLong(FmxHandleToHWND(self.Handle), GCL_HICONSM);
    StrPCopy(szTip, 'testapp');
  end;
end;

end.