FMX - Trayicon message handling

delphi, firemonkey, system-tray

Solution

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}

Problem

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 ?

Original source