I'm having trouble setting up a tray icon with FMX (XE3, Windows). I'm using the same code that can be found in countless threads but I did not get the message handling for the icon to work.
To ilustrate I've created a testapp that sets up the TrayIcon data in the FormCreate and creates it with a button. It will show the correct icon and the correct tooltip, the TrayMessage procedure will never get called though.
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.
I have created the same scenario with VCL and it works as expected. The only difference is directly using Form2.Handle instead of the FMX conversion (and Application.Handle to load the icon data, but that's not part of the issue in FMX). Can anyone point me in the right direction ?
Unlike VCL, FireMonkey does not dispatch raw window messages to FMX controls for custom processing (that would defeat the purpose of a cross-platform framework). FireMonkey has a single WndProc() function implemented in the FMX.Platform.Win unit that is used for all HWND windows that FireMonkey creates. That implementation processes certain window messages that it needs to process, triggering various control methods accordingly (WMPaint(), KeyUp/Down(), MouseUp/Down(), etc), and then passes unprocessed messages directly to DefWindowProc() for OS processing, without letting controls see the messages at all.
So, the only way you are going to gain access to the raw messages is to either:
create your own windows, such as with AllocateHWnd(), or CreateWindow/Ex() directly.
hook into FireMonkey's HWND windows directly via Get/SetWindowLong/Ptr(). Since FireMonkey is a cross-platform framework, and HWND windows are a platform-specific implementation detail, I would suggest avoiding this approach.
use thread-specific message hooks via SetWindowsHookEx(). By making them thread-specific, you avoid having to write a DLL to implement the hook.
In this particular situation, #1 is your best choice. Tray icons are a Windows-specific feature, so you really should use Windows-specific code that is not tied to FireMonkey to handle them. You can use AllocateHWnd() to use a method of your Form class (or any class, for that matter) as the WndProc() for receiving the tray messages while still allowing the Form class to process them. For example:
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}
To handle the windows messages on a FMX form you can override the WndProc of the Form using the GetWindowLong and SetWindowLong functions.
Try this sample
uses
System.SysUtils, System.Types, System.UITypes, System.Classes, System.Variants,
FMX.Types, FMX.Graphics, FMX.Controls, FMX.Forms, FMX.Dialogs, FMX.StdCtrls, Winapi.Messages,
Winapi.Windows, Winapi.ShellAPI, FMX.Platform.Win;
const
WM_ICONTRAY = WM_USER + 1;
type
TForm14 = class(TForm)
Button1: TButton;
procedure FormCreate(Sender: TObject);
procedure Button1Click(Sender: TObject);
private
OrgWndProc: Pointer;
NewWndProc: Pointer;
TrayIconData: TNotifyIconData;
procedure _WndProc(var Message: TMessage);
public
{ Public declarations }
end;
var
Form14: TForm14;
implementation
{$R *.fmx}
procedure TForm14.Button1Click(Sender: TObject);
begin
Shell_NotifyIcon(NIM_ADD, @TrayIconData);
end;
procedure TForm14._WndProc(var Message: TMessage);
begin
if Message.MSG=WM_ICONTRAY then
begin
case Message.LParam of
WM_LBUTTONDOWN: ShowMessage('LBUTTON');
WM_RBUTTONDOWN: ShowMessage('RBUTTON');
else
Message.Result:=CallWindowProc(OrgWndProc, FmxHandleToHWND(Self.Handle), Message.MSG, Message.WParam, Message.LParam);
end;
end
else
Message.Result:=CallWindowProc(OrgWndProc, FmxHandleToHWND(Self.Handle), Message.MSG, Message.WParam, Message.LParam);
end;
procedure TForm14.FormCreate(Sender: TObject);
var
LInstance : Pointer;
begin
//get the current WndProc
OrgWndProc:= Pointer(GetWindowLong(FmxHandleToHWND(Self.Handle), GWL_WNDPROC));
//Convert the class method to a Pointer
LInstance:=MakeObjectInstance(_WndProc);
//set the new WndProc
NewWndProc:= Pointer(SetWindowLong(FmxHandleToHWND(Self.Handle), GWL_WNDPROC, IntPtr(LInstance)));
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;
end.
