Question

我在使用FMX（XE3，Windows）设置托盘图标时遇到问题。我正在使用可以在无数线程中找到的相同代码但我没有得到消息处理图标才能工作。

为了说明我已经创建了一个testapp，它在FormCreate中设置TrayIcon数据并使用按钮创建它。它将显示正确的图标和正确的工具提示，但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

要处理FMX表单上的Windows消息，您可以使用GetWindowLong和SetWindowLong函数覆盖表单的WndProc。

试试这个样本

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.

Answer 2

与VCL不同，FireMonkey不会将原始窗口消息调度到FMX控件以进行自定义处理（这会破坏跨平台框架的目的）。 FireMonkey在WndProc()单元中实现了一个FMX.Platform.Win函数，该函数用于FireMonkey创建的所有HWND窗口。该实现处理它需要处理的某些窗口消息，相应地触发各种控制方法（WMPaint()，KeyUp/Down()，MouseUp/Down()等），然后将未处理的消息直接传递给{{1}用于OS处理，不让控件完全看到消息。

因此，您获得原始邮件访问权限的唯一方法是：

直接创建自己的窗口，例如DefWindowProc()或AllocateHWnd()。
直接通过CreateWindow/Ex()挂钩到FireMonkey的HWND窗口。由于FireMonkey是一个跨平台框架，Get/SetWindowLong/Ptr()窗口是特定于平台的实现细节，我建议避免这种方法。
通过HWND使用特定于线程的消息挂钩。通过使它们特定于线程，您可以避免编写DLL来实现钩子。

在这种特殊情况下，＃1是您的最佳选择。托盘图标是特定于Windows的功能，因此您应该使用与FireMonkey无关的特定于Windows的代码来处理它们。您可以使用SetWindowsHookEx()将Form类（或任何类）的方法用作接收托盘消息的AllocateHWnd()，同时仍允许Form类处理它们。例如：

WndProc()

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;

FMX - Trayicon消息处理

2 个答案: