FMX - Обработка сообщений Trayicon

Question

У меня возникли проблемы с настройкой значка в трее с FMX (XE3, Windows). Я использую тот же код, который можно найти в бесчисленных потоках, но я не получил обработку сообщений для работы значка.

Чтобы создать иллюстрацию, я создал testapp, который устанавливает данные TrayIcon в FormCreate и создает его с помощью кнопки. Он покажет правильный значок и правильную подсказку, процедура TrayMessage никогда не будет вызвана.

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. 

Я создал тот же сценарий с VCL, и он работает как ожидалось. Единственное различие заключается в прямом использовании Form2.Handle вместо преобразования FMX (и Application.Handle для загрузки данных значков, но это не является частью проблемы в FMX). Может кто-то указать мне верное направление ?

Answer 1

В отличие от VCL, FireMonkey не отправляет сырец окна сообщения FMX управления для пользовательской обработки (что бы поражение цели в рамках кросс-платформенной). FireMonkey имеет единственную функцию WndProc(), реализованную в модуле FMX.Platform.Win, который используется для всех окон HWND, которые создает FireMonkey. Эта реализация обрабатывает определенные оконные сообщения, которые необходимо обрабатывать, вызывая соответствующие различные методы управления (WMPaint(), KeyUp/Down(), MouseUp/Down() и т. Д.), А затем передает необработанные сообщения непосредственно на DefWindowProc() для обработки ОС, не позволяя элементам управления видеть сообщения вообще.

Таким образом, единственным способом вы собираетесь получить доступ к необработанным сообщений является либо:

1. создавать свои собственные окна, например, с AllocateHWnd() или CreateWindow/Ex() непосредственно.

2. подключить к окнам HWND FireMonkey напрямую через Get/SetWindowLong/Ptr(). Поскольку FireMonkey представляет собой кросс-платформенную структуру, а окна HWND - это детализация конкретной платформы, я бы предложил избегать этого подхода.

3. использовать поточные сообщения крючки через SetWindowsHookEx(). Создавая потоки, вы избегаете писать DLL, чтобы реализовать крючок.

В этой конкретной ситуации # 1 - ваш лучший выбор. Значки в лотке - это особенность, специфичная для Windows, поэтому вам действительно нужно использовать код, специфичный для Windows, который не привязан к FireMonkey для их обработки. Вы можете использовать AllocateHWnd() для использования метода вашего класса Form (или любого класса, если на то пошло) как WndProc() для приема сообщений в лотке, в то же время позволяя классу Form обрабатывать их. Например:

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} 

Answer 2

Для обработки сообщений Windows в форме FMX вы можете переопределить WndProc формы с использованием функций GetWindowLong и SetWindowLong.

Попробуйте этот образец

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.