Firemonkey in Delphi XE5. How to create popup menu for my icon in the tray?

  

Noticed this – FireMonkey tray icon with a menu

But this topic didn’t help at all.

I did a feature that my program can minimize to the tray (a corner that close to the clock) but i can’t understand how to execute a popup menu for it (that could appear by right clicking on the tray icon). I tried much examples but nothing works.

Here’s my code:

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;

The code above works fine. Next code doesn’t work:

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;

Comments are closed.