delphi - FMX - Trayicon 消息处理

Question

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

为了说明这一点，我创建了一个测试应用程序，它在 FormCreate 中设置 TrayIcon 数据并使用按钮创建它。它将显示正确的图标和正确的工具提示，但 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 不会将原始窗口消息分派(dispatch)给 FMX 控件进行自定义处理(这会违背跨平台框架的目的)。 FireMonkey 在 FMX.Platform.Win 单元中实现了一个 WndProc() 函数，该函数用于 FireMonkey 创建的所有 HWND 窗口。该实现处理它需要处理的某些窗口消息，相应地触发各种控制方法(WMPaint()、KeyUp/Down()、MouseUp/Down() 等)，然后将未处理的消息直接传递给 DefWindowProc() 进行操作系统处理，根本不让控件看到消息。

因此，您要访问原始消息的唯一方法是:

1. 创建您自己的窗口，例如直接使用 AllocateHWnd() 或 CreateWindow/Ex()。

2. 通过 Get/SetWindowLong/Ptr() 直接 Hook FireMonkey 的 HWND 窗口。由于 FireMonkey 是一个跨平台框架，而 HWND 窗口是特定于平台的实现细节，因此我建议避免使用这种方法。

3. 通过SetWindowsHookEx()使用线程特定的消息 Hook 。通过使它们特定于线程，您可以避免编写 DLL 来实现 Hook 。

在这种特殊情况下，#1 是您的最佳选择。托盘图标是 Windows 特定的功能，因此您确实应该使用不与 FireMonkey 绑定(bind)的 Windows 特定代码来处理它们。您可以使用 AllocateHWnd() 来使用 Form 类(或任何类)的方法作为 WndProc() 来接收托盘消息，同时仍然允许Form 类来处理它们。例如:

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}