移出时关闭 TPopupMenu - 在（始终在顶部）应用程序外单击时删除其浮动行为

Question

我的应用程序是 showontop 类型 window，在光标位置弹出一个弹出菜单（mastermenu）意味着在主窗体（demoForm）之外，由外部 winapi 消息（剪贴板更改）触发。

烦人的问题是，当在应用程序外部单击而不是单击任何菜单项或主窗体时，菜单不会消失，就像通常关闭菜单时所做的那样。焦点消失，我的应用程序保持在顶部，菜单保持浮动。

试了很多文章，甚至从D7改成XE5都没有成功。也检查了这一点：我的延迟计时器或托盘控制并不复杂。

具体来说，借用我这样做的解决方案：

procedure TDemoForm.tmrMenumouseOutMonitorTimer(Sender: TObject);
var
  hPopupWnd: HWND;
  R: TRect;
  PT: TPoint;
begin
   hPopupWnd :=  FindWindow('#32768', mastermenu);
  if hPopupWnd = 0 then Exit;
  GetWindowRect(hPopupWnd, R);
  GetCursorPos(Pt);
  if PtInRect(R, Pt) then begin
  //do something
  end else begin
  //do something
  end;
end;

我试图用计时器 (MenumouseOutMonitorTimer) 轮询光标位置，以检测光标是否移出菜单 (mastermenu)。如果它移出，我将发出 .closeMenu()

但是，此代码在 FindWindow() 最后一个参数处抛出 - string, pAnsiChar/pwidestring mismatch in D7/XE5。也许我应该使用 FindWindowEx？ XE5 直接 returns 一些来自 TPopupMenu 的句柄，但我不知道如何使用它们来解决我的问题。

（在 Win7 上，也针对 XP）

我完全是个初学者，如有任何帮助，我们将不胜感激。

完整代码在这里：

unit FmDemo;

interface

uses
  System.Classes,
  Vcl.Controls,
  Vcl.StdCtrls,
  Vcl.Forms, Menus, Dialogs, FileCtrl, ExtCtrls,PJCBView;// ....;

type
  TDemoForm = class(TForm)
    //......
    PJCBViewer1: TPJCBViewer; //custom control
    masterMenu: TPopupMenu;
    tmrMenumouseOutMonitor: TTimer;
    procedure tmrMenumouseOutMonitorTimer(Sender: TObject);

  private
    //........
    procedure menuItemClickHandler(Sender: TObject);
  end;

var
  DemoForm: TDemoForm;

implementation

uses
      Jpeg, Shellapi, Graphics, SysUtils, RichEdit, Messages;//GifImage

{$R *.dfm}

procedure tdemoform.menuItemClickHandler(Sender: TObject);
begin
  //.......
end;

procedure TDemoForm.PJCBViewer1ClipboardChanged(Sender: TObject);
var
   pnt: TPoint;
begin
  demoform.BringToFront; //formStyle -> fsStayOnTop already
  ///////////////////////////////////
  ///menu under cursor display code//
  ///////////////////////////////////

  if GetCursorPos(pnt) then
   begin
      masterMenu.Popup(pnt.X, pnt.Y);
   end;
  //remember to return focus to source window after each menu action (not implemented)
end;

procedure TDemoForm.tmrMenumouseOutMonitorTimer(Sender: TObject);
var
  hPopupWnd: HWND;
  R: TRect;
  PT: TPoint;
begin
  hPopupWnd :=  FindWindow('#32768', masterMenu);
  if hPopupWnd = 0 then Exit;
  GetWindowRect(hPopupWnd, R);
  GetCursorPos(Pt);
  if PtInRect(R, Pt) then begin
  //do something
  end else begin
  //do something
  end;
end;

//... other business logic

initialization
  CF_RTF := RegisterClipboardFormat( richedit.CF_RTF );
end.

Answer 1

这是一个不需要第三方控制的 MCVE。

...

implementation

uses
  menus;

{$R *.dfm}

var
  Pop: TPopupMenu;
  Wnd: HWND;

procedure TForm1.FormCreate(Sender: TObject);
begin
  Left := 200;
  Top := 100;
  Pop := TPopupMenu.Create(nil);
  Pop.Items.Add(TMenuItem.Create(Pop));
  Pop.Items[0].Caption := 'test';
  Wnd := GetForegroundWindow;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  SetForegroundWindow(Wnd); // comment this for the popup to be released when clicked outside
  Pop.Popup(100, 50);
end;

在窗体外单击，弹窗不会释放。

如您所见，我不得不人为地施加重现问题的条件，即当您弹出菜单时，您的 window 不在前台。

如您链接页面的多个位置所述，要正常释放弹出窗口，弹出菜单时您的 window 必须位于前台，这样您就不需要轮询并找到它然后手动释放它。 SetForegroundWindow 不保证您的 window 会排在前面。有关此问题和多个解决方案的详细信息，请参阅 this question。

移出时关闭 TPopupMenu - 在（始终在顶部）应用程序外单击时删除其浮动行为

Close TPopupMenu when moving out of it - removing its floating behavior when clicked outside of an (always on top) application

delphi

delphi-7

delphi-xe5