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()
, orCreateWindow/Ex()
directly.hook into FireMonkey's
HWND
windows directly viaGet/SetWindowLong/Ptr()
. Since FireMonkey is a cross-platform framework, andHWND
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}