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

Question

注意到这一点 - FireMonkey tray icon with a menu

但是这个话题根本没有帮助。

我做了一个功能，我的程序可以最小化到托盘（靠近时钟的角落），但我不明白如何为其执行弹出菜单（可以通过右键单击托盘图标出现） .我尝试了很多例子，但没有任何效果。

这是我的代码：

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;

Answer 1

您使用了错误的窗口句柄。而不是

Wnd:= FmxHandleToHWND(self.Handle);

你需要

Wnd:= TrayWnd;

您还应该从TrayWndProc 中删除message WM_ICONTRAY。它在 FMX 的上下文中毫无用处，只会令人困惑。