Delphi XE5中的Firemonkey。如何为托盘图标创建弹出菜单？

Question

注意这个 - FireMonkey带有菜单的托盘图标

但是这个主题没有帮助到我。

我实现了一个功能，我的程序可以最小化到托盘（靠近时钟的角落），但我不知道如何为它执行弹出菜单（右键点击托盘图标时可能会出现）。我尝试了很多例子，但都没有用。

这是我的代码：

unit MainCode;

interface

uses
  System.SysUtils, System.Types, System.UITypes, System.Classes, System.Variants,
  FMX.Types, FMX.Graphics, FMX.Controls, FMX.Forms, FMX.Dialogs, FMX.StdCtrls,
  FMX.Edit, FMX.Objects, FMX.ListBox, WinApi.ShellApi, WinApi.Windows, WinApi.Messages, FMX.Platform.Win, FMX.Menus, FMX.Platform;

const
      WM_ICONTRAY = WM_USER + 1;

type
  TForm1 = class(TForm)
    PopupMenu1: TPopupMenu;
    MenuItem1: TMenuItem;
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure MenuItem1Click(Sender: TObject);

private
  TrayWnd: HWND;
  TrayIconData: TNotifyIconData;
  TrayIconAdded: Boolean;
  procedure TrayWndProc(var Message: TMessage);

public
  { Public declarations }
end;

var
  Form1: TForm1;

implementation

{$R *.fmx}

procedure TForm1.FormCreate(Sender: TObject);
begin
  TrayWnd := AllocateHWnd(TrayWndProc);
  with TrayIconData do
  begin
    cbSize := SizeOf();
    Wnd:= TrayWnd; // was before Wnd:= FmxHandleToHWND(self.Handle);
    uID:= 0;
    uFlags:= NIF_MESSAGE + NIF_ICON + NIF_TIP;
    uCallbackMessage:= WM_ICONTRAY;
    hIcon:= GetClassLong(FmxHandleToHWND(self.Handle), GCL_HICONSM);
    szTip:= 'Hearthspinner';
  end;

  if not TrayIconAdded then
    TrayIconAdded := Shell_NotifyIcon(NIM_ADD, @TrayIconData);
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
  if TrayIconAdded then
    Shell_NotifyIcon(NIM_DELETE, @TrayIconData);
  DeallocateHWnd(TrayWnd);
end;

procedure TForm1.MenuItem1Click(Sender: TObject);
begin
  Application.Terminate;
end;

上述代码可以正常工作。下面的代码无法正常运行：

procedure TForm1.TrayWndProc(var Message: TMessage);
var P: TPoint;
begin
  if Message.MSG = WM_ICONTRAY then
  begin

    case Message.LParam of
      WM_RBUTTONDOWN:
      begin
        GetCursorPos(P);
        PopupMenu1.Popup(P.X,P.Y);
      end;
    end;
  end
  else
    Message.Result := DefWindowProc(TrayWnd, Message.Msg, Message.WParam, Message.LParam);
end;

- Jerry Green

---

为什么不使用TTrayIcon呢？它有一个PopupMenu属性。 - Jason

@jason 我猜是因为它是一个 VCL 组件。 - David Heffernan

正确。在Firemonkey中没有这样的组件。 - Jerry Green

Answer 1

您正在使用错误的窗口句柄。请改用：

Wnd:= FmxHandleToHWND(self.Handle);

你需要。

Wnd:= TrayWnd;

你还应该从TrayWndProc中删除message WM_ICONTRAY。在FMX的上下文中，它没有任何作用，只会让人感到困惑。

- David Heffernan

---

谢谢！我还删除了 if Message.MSG = WM_ICONTRAY 条件，现在它可以工作了！但是现在我又有一个奇怪的问题：弹出菜单出现在托盘图标菜单的后面（在Windows 7上）。我做了一些截图来解释我的意思： http://i.imgur.com/mYmjT3a.png http://i.imgur.com/NQsxgWV.png我该如何解决它？ - Jerry Green

当我看不到完整的程序，唯一的诊断是“它不工作”时，帮助起来非常困难。 - David Heffernan

与FMX有关的事情。我不了解足够的关于FMX的知识，所以我不能提供任何更多的帮助。 - David Heffernan

我无法帮忙。对于fmx菜单一无所知。关键是WM_RBUTTONDOWN代码被触发了。 - David Heffernan

我很好奇，你为什么接受了？我还没有解决菜单的问题。 - David Heffernan