FMX Delphi中任务栏后面显示的d出菜单

概述所以我一直在根据两个不同的源代码处理这个TrayIcon组件. 一个用于Windows,一个用于Mac. 一切正常,除了当使用FMX TPopupMenu作为托盘图标菜单时,它会不断d出任务栏,有时甚至在从trayicon容器中右键单击应用程序图标时根本不会d出(你知道小盒子)包含所有隐藏的图标？) I found an article on the internet (read here)这表明 所以我一直在根据两个不同的源代码处理这个TrayIcon组件.

一个用于Windows,一个用于Mac.

一切正常,除了当使用FMX TPopupMenu作为托盘图标菜单时,它会不断d出任务栏,有时甚至在从trayicon容器中右键单击应用程序图标时根本不会d出(你知道小盒子)包含所有隐藏的图标？)

I found an article on the internet (read here)这表明VCL TPopupMenu将成为一种解决方法.

我的应用程序是跨平台的,我一直在使用FMX所以我需要使用FMX组件.

现在的问题是：如何在任务栏前d出FMX菜单？

编辑：
注1：我在windows 8.1上使用Delphi XE7
注2：在附加的代码中,uses子句中有一部分可以被注释掉,以便测试FMX.Menus或VCL.Menus,然后
Create构造函数中有一大块代码也必须取消注释才能与VCL.Menus一起使用.

这是我的托盘图标代码：

{The source is from Nix0N,[email protected],www.nixcode.ru,Ver 0.1.}unit QTray;interfaceuses  System.SysUtils,System.Classes,System.TypInfo,System.UITypes,WinAPI.ShellAPI,WinAPI.windows,WinAPI.Messages,FMX.Platform.Win,VCL.graphics,VCL.Controls,FMX.Dialogs,FMX.Forms,FMX.Objects,FMX.Types,FMX.Graphics,FMX.Surfaces,FMX.Menus //Comment this to use FMX Menus//,VCL.Menus //comment this to use VCL Menus  ;type  TOnBalloonClick = procedure(Sender: TObject; ID: integer; ATagstr: string) of object;  TBalloonIconType = (None,Info,Warning,Error,User,BigWarning,BigError);  TCrosstray = class  private    fForm : TForm;    fHint : string;    fBalloonTitle     : string;    fBalloonText      : string;    fBalloonIconType  : TBalloonIconType;    fTrayIcon     : TNotifyIconData ;    fTrayMenu     : TPopupMenu      ;    fIndent       : Integer         ;    fOnClick      : TNotifyEvent    ;    fOnMouseDown,fonmouseup,fOnDblClick   : TMouseEvent     ;    fOnMouseEnter,fOnMouseLeave : TNotifyEvent    ;//    fOnMouseMove  : TMouseMoveEvent ;    fOnBalloonShow,fOnBalloonHIDe,fOnBalloonTimeout   : TNotifyEvent    ;    fOnBalloonUserClick : TOnBalloonClick ;    fWinIcon : TIcon;    procedure ShowBallonHint;  protected  public    constructor Create; overload;    constructor Create(AForm: TForm); overload;//AForm isn't used in MacOS,but is left there for seamless inegration in your app    destructor  Destroy;    procedure CreateMSwindows;    procedure Show;    procedure HIDe;    procedure Balloon           (ATitle,AMessage: string; AType: TBalloonIconType; AID: integer; ATagstr: string);    procedure BalloonNone       (ATitle,AMessage: string; AID: integer; ATagstr: string);    procedure BalloonInfo       (ATitle,AMessage: string; AID: integer; ATagstr: string);    procedure BalloonWarning    (ATitle,AMessage: string; AID: integer; ATagstr: string);    procedure BalloonWarningBig (ATitle,AMessage: string; AID: integer; ATagstr: string);    procedure BalloonError      (ATitle,AMessage: string; AID: integer; ATagstr: string);    procedure BalloonErrorBig   (ATitle,AMessage: string; AID: integer; ATagstr: string);    procedure BalloonUser       (ATitle,AMessage: string; AID: integer; ATagstr: string);    procedure LoadIconFromfile(APath: UTF8String);    procedure OnIconChange(Sender: TObject);    function GetIconRect: TRect;  published    property Hint               : string            read fHint                write fHint               ;    property BalloonText        : string            read fBalloonText         write fBalloonText        ;    property BalloonTitle       : string            read fBalloonTitle        write fBalloonTitle       ;    property IconBalloonType    : TBalloonIconType  read fBalloonIconType     write fBalloonIconType    ;    property Indent             : Integer           read fIndent              write fIndent             ;    property PopUpMenu          : TPopupMenu        read fTrayMenu            write fTrayMenu           ;    property OnClick            : TNotifyEvent      read fOnClick             write fOnClick            ;    property OnMouseDown        : TMouseEvent       read fOnMouseDown         write fOnMouseDown        ;    property onmouseup          : TMouseEvent       read fonmouseup           write fonmouseup          ;    property OnDblClick         : TMouseEvent       read fOnDblClick          write fOnDblClick         ;    property OnMouseEnter       : TNotifyEvent      read fOnMouseEnter        write fOnMouseEnter       ;    property OnMouseLeave       : TNotifyEvent      read fOnMouseLeave        write fOnMouseLeave       ;    property OnBalloonShow      : TNotifyEvent      read fOnBalloonShow       write fOnBalloonShow      ;    property OnBalloonHIDe      : TNotifyEvent      read fOnBalloonHIDe       write fOnBalloonHIDe      ;    property OnBalloonTimeout   : TNotifyEvent      read fOnBalloonTimeout    write fOnBalloonTimeout   ;    property OnBalloonUserClick : TOnBalloonClick   read fOnBalloonUserClick  write fOnBalloonUserClick ;//    property OnMouseMove      : TMouseMoveEvent   read fOnMouseMove     write fOnMouseMove      ;  end;  var    golDWndProc: LONG_PTR;    gHWND: TWinWindowHandle;    gPopUpMenu: TPopupMenu;    gFirstRun: Boolean = True;    gIndent: Integer;    gOnClick      : TNotifyEvent    ;    gOnMouseDown,gonmouseup,gOnDblClick   : TMouseEvent     ;    gOnMouseEnter,gOnMouseLeave : TNotifyEvent;//    gOnMouseMove  : TMouseMoveEvent ;    gOnBalloonShow,gOnBalloonHIDe,gOnBalloonTimeout   : TNotifyEvent    ;    gOnBalloonUserClick : TOnBalloonClick ;    gBalloonID: integer;    gBalloonTagstr: string;    gXTrayIcon: TCrosstray;    function MyWndProc(HWND: HWND; Msg: UINT; WParam: WParam; LParam: LParam): LRESulT; stdcall;  const WM_TRAYICON = WM_USER + 1;implementationconstructor TCrosstray.Create;beginend;constructor TCrosstray.Create(AForm: TForm);begin  inherited Create;  fForm   := AForm; CreateMSwindows;  //uncomment the following block for a simple hello world menu using VCL.Menu  { fTrayMenu := TPopupMenu.Create(nil);    fTrayMenu.Items.Add(TMenuItem.Create(nil));    fTrayMenu.Items.Add(TMenuItem.Create(nil));    fTrayMenu.Items.Items[0].Caption := 'hello';    fTrayMenu.Items.Items[1].Caption := 'world!';    }  //To use FMX Menus,just assign one from your main formend;procedure TCrosstray.CreateMSwindows;begin  fWinIcon := TIcon.Create;  fWinIcon.OnChange := OnIconChange;  fIndent   := 75;  Show;end;function MyWndProc(HWND: HWND; Msg: UINT; WParam: WParam; LParam: LParam): LRESulT; stdcall;var  CurPos: TPoint;  Shift: TShiftState;begin  Result := 0;  GetCursorPos(CurPos);  Shift := [];  if Msg = WM_TRAYICON then  begin    case lParam of      NIN_BALLOONSHOW       : if assigned(gOnBalloonShow) then gOnBalloonShow(nil)       ; //when balloon has been showed      NIN_BALLOONHIDE       : if assigned(gOnBalloonHIDe) then gOnBalloonHIDe(nil)       ; //when balloon has been hIDden      NIN_BALLOONTIMEOUT    : if assigned(gOnBalloonTimeout) then gOnBalloonTimeout(nil)    ; //when balloon has been timed out      NIN_BALLOONUSERCliCK  : if assigned(gOnBalloonUserClick) then gOnBalloonUserClick(nil,gBalloonID,gBalloonTagstr)  ; //when balloon has been clicked      WM_LbuttonDOWN        : if assigned(gOnMouseDown) then gOnMouseDown(nil,mbleft,Shift,CurPos.X,CurPos.Y); //when left mouse button is DOWN on the tray icon      WM_RbuttonDOWN        : if assigned(gOnMouseDown) then gOnMouseDown(nil,mbRight,CurPos.Y); //when RIGHT mouse button is DOWN on the tray icon      WM_LbuttonUP          : //when left mouse button is UP on the tray icon        begin          if assigned(gonmouseup) then gonmouseup(nil,CurPos.Y);          if assigned(gOnClick) then gOnClick(nil);        end;      WM_RbuttonUP          : //when RIGHT mouse button is UP on the tray icon        begin          if assigned(gonmouseup) then gonmouseup(nil,CurPos.Y);          SetForegrounDWindow(gHWND.Wnd);          if assigned(gPopUpMenu) then gPopUpMenu.PopUp(CurPos.X,CurPos.Y - gIndent);        end;      WM_LbuttonDBLCLK      : if assigned(gOnDblClick) then gOnDblClick(nil,CurPos.Y); //when tray icon has been DOUBLECliCKED with left mouse button      WM_RbuttonDBLCLK      : if assigned(gOnDblClick) then gOnDblClick(nil,CurPos.Y); //when tray icon has been DOUBLECliCKED with RIGHT mouse button      WM_MOUSEHOVER : if assigned(gOnMouseEnter) then gOnMouseEnter(nil);      WM_MOUSELEAVE : showmessage('a');//if assigned(gOnMouseLeave) then gOnMouseLeave(nil);//      WM_MOUSEMOVE          : gOnMouseMove(nil,CurPos.Y); //This one causes an error    end;  end;  Result := CallWindowProc(Ptr(golDWndProc),HWND,Msg,WParam,LParam);end;procedure TCrosstray.Show;begin  gHWND         := WindowHandletoPlatform(fForm.Handle);  gPopUpMenu    := fTrayMenu    ;  gIndent       := fIndent      ;  gOnClick            := fOnClick             ;  gOnMouseDown        := fOnMouseDown         ;  gonmouseup          := fonmouseup           ;  gOnDblClick         := fOnDblClick          ;  gOnMouseEnter       := fOnMouseEnter        ;  gOnMouseLeave       := fOnMouseLeave        ;//  gOnMouseMove        := fOnMouseMove         ;  gOnBalloonShow      := fOnBalloonShow       ;  gOnBalloonHIDe      := fOnBalloonHIDe       ;  gOnBalloonTimeout   := fOnBalloonTimeout    ;  gOnBalloonUserClick := fOnBalloonUserClick  ;  with fTrayIcon do  begin    cbSize := SizeOf;    Wnd := gHWND.Wnd;    uID := 1;    uFlags := NIF_MESSAGE + NIF_ICON + NIF_TIP;// + NIF_STATE + NIF_INFO + NIF_GUID + NIF_REALTIME + NIF_SHOWTIP;    DWInfoFlags := NIIF_NONE;    uCallbackMessage := WM_TRAYICON;    hIcon := GetClassLong(gHWND.Wnd,GCL_HICONSM);    StrLcopy(szTip,PChar(fHint),High(szTip));  end;  Shell_NotifyIcon(NIM_ADD,@fTrayIcon);  if gFirstRun then  begin    golDWndProc := getwindowlongPtr(gHWND.Wnd,GWL_WNDPROC);    SetwindowLongPtr(gHWND.Wnd,GWL_WNDPROC,LONG_PTR(@MyWndProc));    gFirstRun := False;  end;end;procedure TCrosstray.ShowBallonHint;begin  with fTrayIcon do  begin    StrLcopy(szInfo,PChar(fBalloonText),High(szInfo));    StrLcopy(szInfoTitle,PChar(fBalloonTitle),High(szInfoTitle));    uFlags := NIF_INFO;    case fBalloonIconType of      None        : DWInfoFlags := 0;      Info        : DWInfoFlags := 1;      Warning     : DWInfoFlags := 2;      Error       : DWInfoFlags := 3;      User        : DWInfoFlags := 4;      BigWarning  : DWInfoFlags := 5;      BigError    : DWInfoFlags := 6;    end;  end;  Shell_NotifyIcon(NIM_MODIFY,@fTrayIcon);end;procedure TCrosstray.Balloon(ATitle,AMessage: string; AType: TBalloonIconType; AID: integer; ATagstr: string);begin  BalloonTitle    := ATitle   ;  BalloonText     := AMessage ;  IconBalloonType := AType    ;  gBalloonID      := AID      ;  gBalloonTagstr  := ATagstr  ;  ShowBallonHint;end;procedure TCrosstray.BalloonNone(ATitle,AMessage: string; AID: integer; ATagstr: string);begin  Balloon(ATitle,AMessage,None,AID,ATagstr);end;procedure TCrosstray.BalloonInfo(ATitle,ATagstr);end;procedure TCrosstray.BalloonWarning(ATitle,ATagstr);end;procedure TCrosstray.BalloonWarningBig(ATitle,ATagstr);end;procedure TCrosstray.BalloonError(ATitle,ATagstr);end;procedure TCrosstray.BalloonErrorBig(ATitle,BigError,ATagstr);end;procedure TCrosstray.BalloonUser(ATitle,ATagstr);end;procedure TCrosstray.HIDe;begin  Shell_NotifyIcon(NIM_DELETE,@fTrayIcon);end;destructor TCrosstray.Destroy;begin  Shell_NotifyIcon(NIM_DELETE,@fTrayIcon);  fWinIcon.Free;  inherited;end;procedure TCrosstray.OnIconChange(Sender: TObject);begin  fTrayIcon.hIcon := fWinIcon.Handle;  Shell_NotifyIcon(NIM_MODIFY,@fTrayIcon);end;function TCrosstray.GetIconRect: TRect;  var  S: NOTIFYICONIDENTIFIER;begin  FillChar(S,SizeOf(S),#0);  S.cbSize := SizeOf(NOTIFYICONIDENTIFIER);  S.hWnd := fTrayIcon.Wnd;  S.uID := fTrayIcon.uID;  Shell_NotifyIconGetRect(S,result);end;procedure TCrosstray.LoadIconFromfile(APath: UTF8String);begin  fWinIcon.LoadFromfile(APath);end;end.

解决方法 更换：

gHWND         := WindowHandletoPlatform(fForm.Handle);

附：

gHWND         := ApplicationHWND;

总结

以上是内存溢出为你收集整理的FMX Delphi中任务栏后面显示的d出菜单全部内容，希望文章能够帮你解决FMX Delphi中任务栏后面显示的d出菜单所遇到的程序开发问题。

如果觉得内存溢出网站内容还不错，欢迎将内存溢出网站推荐给程序员好友。