So i’ve been working on this TrayIcon component based off of two different source codes.

One for Windows, and one for Mac.

Everything works fine except that when using an FMX TPopupMenu as the tray icon menu, it keeps popping up behind the taskbar and sometimes it does not even pop at all when right clicking on the app icon from within the trayicon container (you know the little box that contains all hidden icons?)

I found an article on the internet (read here) which suggested that VCL TPopupMenu would be a workaround.

My application is cross-platform and I am using FMX all the way through so I need to use FMX components.

Now for the question: How do I make an FMX menu pop in front of the taskbar?

EDIT:
Note 1: I use Delphi XE7 on Windows 8.1
Note 2: In the attached code, there’s a part in the uses clause which can be commented out in order to test either FMX.Menus or VCL.Menus, and then
there’s a chunk of code in the Create constructor that also has to be un-commented for use with VCL.Menus.

Here is my tray icon code:

{The source is from Nix0N, livtavit@mail.ru, www.nixcode.ru, Ver 0.1.
}

unit QTray;

interface

uses
System.SysUtils, System.Classes, System.TypInfo,
System.UITypes,

Winapi.ShellAPI, Winapi.Windows,
Winapi.Messages, FMX.Platform.Win, VCL.graphics,
VCL.Controls,

FMX.Dialogs, FMX.Forms,
FMX.Objects, FMX.Types,
FMX.Graphics, FMX.Surfaces,
FMX.Menus //Comment this to use FMX Menus
// , VCL.Menus //comment this to use VCL Menus
;

type
TOnBalloonClick = procedure(Sender: TObject; ID: integer; ATagStr: string) of object;
TBalloonIconType = (None, Info, Warning, Error, User, BigWarning, BigError);

TCrossTray = class
private
fForm : TForm;
fHint : string;
fBalloonTitle : string;
fBalloonText : string;
fBalloonIconType : TBalloonIconType;
fTrayIcon : TNotifyIconData ;
fTrayMenu : TPopupMenu ;
fIndent : Integer ;

fOnClick : TNotifyEvent ;
fOnMouseDown,
fOnMouseUp,
fOnDblClick : TMouseEvent ;
fOnMouseEnter,
fOnMouseLeave : TNotifyEvent ;
// fOnMouseMove : TMouseMoveEvent ;

fOnBalloonShow,
fOnBalloonHide,
fOnBalloonTimeout : TNotifyEvent ;
fOnBalloonUserClick : TOnBalloonClick ;

fWinIcon : TIcon;

procedure ShowBallonHint;
protected
public
constructor Create; overload;
constructor Create(AForm: TForm); overload;//AForm isn’t used in MacOS, but is left there for seamless inegration in your app
destructor Destroy;

procedure CreateMSWindows;
procedure Show;
procedure Hide;

procedure Balloon (ATitle, AMessage: string; AType: TBalloonIconType; AID: integer; ATagStr: string);
procedure BalloonNone (ATitle, AMessage: string; AID: integer; ATagStr: string);
procedure BalloonInfo (ATitle, AMessage: string; AID: integer; ATagStr: string);
procedure BalloonWarning (ATitle, AMessage: string; AID: integer; ATagStr: string);
procedure BalloonWarningBig (ATitle, AMessage: string; AID: integer; ATagStr: string);
procedure BalloonError (ATitle, AMessage: string; AID: integer; ATagStr: string);
procedure BalloonErrorBig (ATitle, AMessage: string; AID: integer; ATagStr: string);
procedure BalloonUser (ATitle, AMessage: string; AID: integer; ATagStr: string);

procedure LoadIconFromFile(APath: UTF8String);
procedure OnIconChange(Sender: TObject);

function GetIconRect: TRect;
published

property Hint : string read fHint write fHint ;
property BalloonText : string read fBalloonText write fBalloonText ;
property BalloonTitle : string read fBalloonTitle write fBalloonTitle ;
property IconBalloonType : TBalloonIconType read fBalloonIconType write fBalloonIconType ;
property Indent : Integer read fIndent write fIndent ;
property PopUpMenu : TPopupMenu read fTrayMenu write fTrayMenu ;

property OnClick : TNotifyEvent read fOnClick write fOnClick ;
property OnMouseDown : TMouseEvent read fOnMouseDown write fOnMouseDown ;
property OnMouseUp : TMouseEvent read fOnMouseUp write fOnMouseUp ;
property OnDblClick : TMouseEvent read fOnDblClick write fOnDblClick ;

property OnMouseEnter : TNotifyEvent read fOnMouseEnter write fOnMouseEnter ;
property OnMouseLeave : TNotifyEvent read fOnMouseLeave write fOnMouseLeave ;

property OnBalloonShow : TNotifyEvent read fOnBalloonShow write fOnBalloonShow ;
property OnBalloonHide : TNotifyEvent read fOnBalloonHide write fOnBalloonHide ;
property OnBalloonTimeout : TNotifyEvent read fOnBalloonTimeout write fOnBalloonTimeout ;
property OnBalloonUserClick : TOnBalloonClick read fOnBalloonUserClick write fOnBalloonUserClick ;

// property OnMouseMove : TMouseMoveEvent read fOnMouseMove write fOnMouseMove ;

end;

var
gOldWndProc: LONG_PTR;
gHWND: TWinWindowHandle;
gPopUpMenu: TPopupMenu;
gFirstRun: Boolean = True;
gIndent: Integer;

gOnClick : TNotifyEvent ;
gOnMouseDown,
gOnMouseUp,
gOnDblClick : TMouseEvent ;
gOnMouseEnter,
gOnMouseLeave : TNotifyEvent;
// gOnMouseMove : TMouseMoveEvent ;

gOnBalloonShow,
gOnBalloonHide,
gOnBalloonTimeout : TNotifyEvent ;
gOnBalloonUserClick : TOnBalloonClick ;

gBalloonID: integer;
gBalloonTagStr: string;

gXTrayIcon: TCrossTray;

function MyWndProc(HWND: HWND; Msg: UINT; WParam: WParam; LParam: LParam): LRESULT; stdcall;

const WM_TRAYICON = WM_USER + 1;

implementation

constructor TCrossTray.Create;
begin

end;

constructor TCrossTray.Create(AForm: TForm);
begin
inherited Create;

fForm := AForm; CreateMSWindows;

//uncomment the following block for a simple hello world menu using VCL.Menu
{ fTrayMenu := TPopupMenu.Create(nil);
fTrayMenu.Items.Add(TMenuItem.Create(nil));
fTrayMenu.Items.Add(TMenuItem.Create(nil));
fTrayMenu.Items.Items[0].Caption := ‘hello’;
fTrayMenu.Items.Items[1].Caption := ‘world!’;
}

//To use FMX Menus, just assign one from your main form

end;

procedure TCrossTray.CreateMSWindows;
begin
fWinIcon := TIcon.Create;
fWinIcon.OnChange := OnIconChange;

fIndent := 75;

Show;
end;

function MyWndProc(HWND: HWND; Msg: UINT; WParam: WParam; LParam: LParam): LRESULT; stdcall;
var
CurPos: TPoint;
Shift: TShiftState;
begin
Result := 0;

GetCursorPos(CurPos);

Shift := [];

if Msg = WM_TRAYICON then
begin
case lParam of
NIN_BALLOONSHOW : if assigned(gOnBalloonShow) then gOnBalloonShow(nil) ; //when balloon has been showed
NIN_BALLOONHIDE : if assigned(gOnBalloonHide) then gOnBalloonHide(nil) ; //when balloon has been hidden
NIN_BALLOONTIMEOUT : if assigned(gOnBalloonTimeout) then gOnBalloonTimeout(nil) ; //when balloon has been timed out
NIN_BALLOONUSERCLICK : if assigned(gOnBalloonUserClick) then gOnBalloonUserClick(nil, gBalloonID, gBalloonTagStr) ; //when balloon has been clicked

WM_LBUTTONDOWN : if assigned(gOnMouseDown) then gOnMouseDown(nil, mbLeft, Shift, CurPos.X, CurPos.Y); //when LEFT mouse button is DOWN on the tray icon
WM_RBUTTONDOWN : if assigned(gOnMouseDown) then gOnMouseDown(nil, mbRight, Shift, CurPos.X, CurPos.Y); //when RIGHT mouse button is DOWN on the tray icon

WM_LBUTTONUP : //when LEFT mouse button is UP on the tray icon
begin
if assigned(gOnMouseUp) then gOnMouseUp(nil, mbLeft, Shift, CurPos.X, CurPos.Y);
if assigned(gOnClick) then gOnClick(nil);
end;

WM_RBUTTONUP : //when RIGHT mouse button is UP on the tray icon
begin
if assigned(gOnMouseUp) then gOnMouseUp(nil, mbRight, Shift, CurPos.X, CurPos.Y);

SetForegroundWindow(gHWND.Wnd);
if assigned(gPopUpMenu) then gPopUpMenu.PopUp(CurPos.X, CurPos.Y – gIndent);
end;

WM_LBUTTONDBLCLK : if assigned(gOnDblClick) then gOnDblClick(nil, mbLeft, Shift, CurPos.X, CurPos.Y); //when tray icon has been DOUBLECLICKED with LEFT mouse button
WM_RBUTTONDBLCLK : if assigned(gOnDblClick) then gOnDblClick(nil, mbRight, Shift, CurPos.X, CurPos.Y); //when tray icon has been DOUBLECLICKED with RIGHT mouse button

WM_MOUSEHOVER : if assigned(gOnMouseEnter) then gOnMouseEnter(nil);
WM_MOUSELEAVE : showmessage(‘a’);//if assigned(gOnMouseLeave) then gOnMouseLeave(nil);

// WM_MOUSEMOVE : gOnMouseMove(nil, Shift, CurPos.X, CurPos.Y); //This one causes an error
end;
end;

Result := CallWindowProc(Ptr(gOldWndProc), HWND, Msg, WParam, LParam);
end;

procedure TCrossTray.Show;
begin
gHWND := WindowHandleToPlatform(fForm.Handle);
gPopUpMenu := fTrayMenu ;
gIndent := fIndent ;

gOnClick := fOnClick ;
gOnMouseDown := fOnMouseDown ;
gOnMouseUp := fOnMouseUp ;
gOnDblClick := fOnDblClick ;
gOnMouseEnter := fOnMouseEnter ;
gOnMouseLeave := fOnMouseLeave ;
// gOnMouseMove := fOnMouseMove ;
gOnBalloonShow := fOnBalloonShow ;
gOnBalloonHide := fOnBalloonHide ;
gOnBalloonTimeout := fOnBalloonTimeout ;
gOnBalloonUserClick := fOnBalloonUserClick ;

with fTrayIcon do
begin
cbSize := SizeOf;
Wnd := gHWND.Wnd;
uID := 1;
uFlags := NIF_MESSAGE + NIF_ICON + NIF_TIP;// + NIF_STATE + NIF_INFO + NIF_GUID + NIF_REALTIME + NIF_SHOWTIP;
dwInfoFlags := NIIF_NONE;
uCallbackMessage := WM_TRAYICON;
hIcon := GetClassLong(gHWND.Wnd, GCL_HICONSM);
StrLCopy(szTip, PChar(fHint), High(szTip));
end;

Shell_NotifyIcon(NIM_ADD, @fTrayIcon);

if gFirstRun then
begin
gOldWndProc := GetWindowLongPtr(gHWND.Wnd, GWL_WNDPROC);
SetWindowLongPtr(gHWND.Wnd, GWL_WNDPROC, LONG_PTR(@MyWndProc));
gFirstRun := False;
end;
end;

procedure TCrossTray.ShowBallonHint;
begin
with fTrayIcon do
begin
StrLCopy(szInfo, PChar(fBalloonText), High(szInfo));
StrLCopy(szInfoTitle, PChar(fBalloonTitle), High(szInfoTitle));
uFlags := NIF_INFO;

case fBalloonIconType of
None : dwInfoFlags := 0;
Info : dwInfoFlags := 1;
Warning : dwInfoFlags := 2;
Error : dwInfoFlags := 3;
User : dwInfoFlags := 4;
BigWarning : dwInfoFlags := 5;
BigError : dwInfoFlags := 6;
end;
end;

Shell_NotifyIcon(NIM_MODIFY, @fTrayIcon);
end;

procedure TCrossTray.Balloon(ATitle, AMessage: string; AType: TBalloonIconType; AID: integer; ATagStr: string);
begin
BalloonTitle := ATitle ;
BalloonText := AMessage ;
IconBalloonType := AType ;
gBalloonID := AID ;
gBalloonTagStr := ATagStr ;
ShowBallonHint;
end;

procedure TCrossTray.BalloonNone(ATitle, AMessage: string; AID: integer; ATagStr: string);
begin
Balloon(ATitle, AMessage, None, AID, ATagStr);
end;

procedure TCrossTray.BalloonInfo(ATitle, AMessage: string; AID: integer; ATagStr: string);
begin
Balloon(ATitle, AMessage, Info, AID, ATagStr);
end;

procedure TCrossTray.BalloonWarning(ATitle, AMessage: string; AID: integer; ATagStr: string);
begin
Balloon(ATitle, AMessage, Warning, AID, ATagStr);
end;

procedure TCrossTray.BalloonWarningBig(ATitle, AMessage: string; AID: integer; ATagStr: string);
begin
Balloon(ATitle, AMessage, BigWarning, AID, ATagStr);
end;

procedure TCrossTray.BalloonError(ATitle, AMessage: string; AID: integer; ATagStr: string);
begin
Balloon(ATitle, AMessage, Error, AID, ATagStr);
end;

procedure TCrossTray.BalloonErrorBig(ATitle, AMessage: string; AID: integer; ATagStr: string);
begin
Balloon(ATitle, AMessage, BigError, AID, ATagStr);
end;

procedure TCrossTray.BalloonUser(ATitle, AMessage: string; AID: integer; ATagStr: string);
begin
Balloon(ATitle, AMessage, User, AID, ATagStr);
end;

procedure TCrossTray.Hide;
begin
Shell_NotifyIcon(NIM_DELETE, @fTrayIcon);
end;

destructor TCrossTray.Destroy;
begin
Shell_NotifyIcon(NIM_DELETE, @fTrayIcon);
fWinIcon.Free;
inherited;
end;

procedure TCrossTray.OnIconChange(Sender: TObject);
begin
fTrayIcon.hIcon := fWinIcon.Handle;
Shell_NotifyIcon(NIM_MODIFY, @fTrayIcon);
end;

function TCrossTray.GetIconRect: TRect;
var S: NOTIFYICONIDENTIFIER;
begin
FillChar(S, SizeOf(S), #0);
S.cbSize := SizeOf(NOTIFYICONIDENTIFIER);
S.hWnd := fTrayIcon.Wnd;
S.uID := fTrayIcon.uID;

Shell_NotifyIconGetRect(S, result);
end;

procedure TCrossTray.LoadIconFromFile(APath: UTF8String);
begin
fWinIcon.LoadFromFile(APath);
end;

end.