当鼠标指针在弹出菜单外时自动隐藏或关闭弹出菜单 - Delphi

Question

我的应用程序中有一个 PopupMenu，当用户右键单击我的应用程序的通知区域图标时弹出。

当我右键单击该图标，弹出菜单，什么都不做时，我的应用程序表现得像恢复工作一样，因为它看起来像是在等待，直到我单击菜单项。

我想删除此行为。当没有来自用户的响应以及鼠标指针离开 PopupMenu 时，我尝试通过添加自动关闭过程来修复 PopupMenu。

我还尝试添加一个 TTimer 在指定时间后关闭我的 TPopUpMenu，但它会在我指定的时间后关闭，而不会查看鼠标指针是在 PopupMenu 内部还是外部。

我想要实现的两个场景是：

我希望 TPopUpMenu 在用户将鼠标指针移出它超过两三秒时关闭。
当用户在其中移动鼠标指针时，TPopupMenu 应在五分钟后关闭，因为任何用户都应在五分钟内响应 PopupMenu .

我尝试将以下带有 TTimer 的代码添加到我的应用程序的事件处理程序中，该事件处理程序在用户右键单击托盘图标时打开 PopupMenu，但 PopupMenu 总是在两秒后关闭：

procedure TMainForm_1.SysTrayIconMessageHandler(var Msg: TMessage);
var
   SysTrayTimer: TTimer;
   PT: TPoint;
begin
  case Msg.LParam of      
    WM_.....:;
    WM_RBUTTONDOWN:
    begin
      GetCursorPos(PT);
      SysTrayTimer.Enabled := True;
      SysTrayTimer.Interval := 2500;
      SystemTrayPopUpMenu.PopUp(PT.X, PT.Y);
      SystemTrayPopUpMenu.AutoLineReduction := maAutomatic;
    end;
  end;
end;

procedure TMainForm_1.OnSysTrayTimer(Sender: TObject);
begin
  SysTrayTimer.Enabled := False;
  SendMessage(PopupList.Window, WM_CANCELMODE, 0, 0);
end;

我也看了this，但是在我添加代码之后，什么都没有改变。

至少，我必须能够做到这一点：在用户通过右键单击打开 PopupMenu 并将鼠标指针移出它之后关闭它。

这就是我添加新代码来实现此目的的方式：

unit MainForm_1;

interface

uses
  Windows, SysUtils, Messages, Classes, Graphics, Controls,
  Forms, Dialogs, StdCtrls, ExtCtrls, Menus, ImgList;

type
  TMainForm_1 = class(TForm);
    SystemTrayPopUpMenu: TPopUpMenu;
    ExitTheProgram: TMenuItem;
    RestoreFromSystemTray: TMenuItem; 
    ReadTheInstructions: TMenuItem;
    Separator1: TMenuItem;
    TrackSysTrayMenuTimer: TTimer;
    CloseSysTrayMenuTimer: TTimer;
    procedure OnTrackSysTrayMenuTimer(Sender: TObject);
    procedure OnCloseSysTrayMenuTimer(Sender: TObject);  
    procedure SysTrayPopUpMenuPopUp(Sender: TObject);
  private
    MouseInSysTrayPopUpMenu: Boolean;
    IconData: TNotifyIconData; 
    procedure SysTrayIconMsgHandler(var Msg: TMessage); message TRAY_CALLBACK;
    procedure AddSysTrayIcon;
    procedure DisplayBalloonTips;
    procedure ApplySystemTrayIcon;
    procedure DeleteSysTrayIcon;
  public
    IsSystemTrayIconShown: Boolean;
  end;

var
  MainForm_1: TMainForm_1;

implementation

uses
  ShlObj, MMSystem, ShellAPI, SHFolder,.....;

procedure TMainForm_1.SysTrayIconMsgHandler(var Msg: TMessage);
var
  PT: TPoint;
begin
  case Msg.LParam of
    WM_MOUSEMOVE:;
    WM_LBUTTONUP:;
    WM_LBUTTONDBLCLK:;
    WM_RBUTTONUP:;
    WM_RBUTTONDBLCLK:;
    WM_LBUTTONDOWN:;
    NIN_BALLOONSHOW:;
    NIN_BALLOONHIDE:;
    NIN_BALLOONTIMEOUT:;
    NIN_BALLOONUSERCLICK:;
    WM_RBUTTONDOWN:
    begin
      GetCursorPos(PT);
      SetForegroundWindow(Handle);
      SystemTrayPopUpMenu.OnPopup := SysTrayPopUpMenuPopUp;
      SystemTrayPopUpMenu.PopUp(Pt.X, Pt.Y);
      PostMessage(Handle, WM_NULL, 0, 0);
      TrackSysTrayMenuTimer.Enabled := False;
      CloseSysTrayMenuTimer.Enabled := False;
    end;
  end;
end;

procedure TMainForm_1.SysTrayPopUpMenuPopup(Sender: TObject);
begin
  MouseInSysTrayMenu := True;
  TrackSysTrayMenuTimer.Interval := 100;
  TrackSysTrayMenuTimer.OnTimer := OnTrackSysTrayMenuTimer;
  TrackSysTrayMenuTimer.Enabled := True;
  CloseSysTrayMenuTimer.Interval := 300000;
  CloseSysTrayMenuTimer.OnTimer := OnCloseSysTrayMenuTimer;
  CloseSysTrayMenuTimer.Enabled := True;
end;

procedure TMainForm_1.OnTrackSysTrayMenuTimer(Sender: TObject);
var
  hPopupWnd: HWND;
  R: TRect;
  PT: TPoint;
begin
  hPopupWnd := FindWindow('#32768', nil);
  if hPopupWnd = 0 then Exit;
  GetWindowRect(hPopupWnd, R);
  GetCursorPos(Pt);
  if PtInRect(R, Pt) then begin
    if not MouseInSysTrayMenu then begin
      MouseInSysTrayMenu := True;
      CloseSysTrayMenuTimer.Interval := 300000;
    end;
  end else begin
    if MouseInSysTrayMenu then begin
      MouseInSysTrayMenu := False;
      CloseSysTrayMenuTimer.Interval := 2500;
    end;
  end;
end; 

procedure TMainForm_1.OnCloseSysTrayMenuTimer(Sender: TObject);
begin
  CloseSysTrayMenuTimer.Enabled := False;
  SendMessage(PopupList.Window, WM_CANCELMODE, 0, 0);
end;

两个TTimers在App的MainForm中是如何使用的：

我如何分配 TrackSysTrayMenuTimer 的属性值.....

我如何分配 CloseSysTrayMenuTimer 的属性值.....

我也收到这样的异常消息.....

这是我写的这样一条消息，用于检查代码中有什么问题......因此我可以确定 FindWindow 是否失败...... ..

...
hPopupWnd := FindWindow('#32768', nil);
if hPopupWnd = 0 then
begin
TrackSysTrayMenuTimer.Enabled := False;
if ShowErrors = True and TestingMode = True then
Application.MessageBox('The PopUp Menu "SystemTrayPopUpMenu" could not be found.' +
' FindWindow will abort.', '                                      Exception Message', MB_ICONSTOP or MB_OK);
exit;

我收到的最后一个错误是：

提前致谢。

Answer 1

标准弹出菜单不应在用户将鼠标移出时自动关闭。用户应该点击某处将其关闭。

如果您真的想在鼠标移出弹出菜单时自动关闭弹出菜单，则必须手动实现自己的跟踪以了解鼠标何时移出菜单的当前显示坐标。

也就是说，您的代码中还有一个错误需要修复。每 MSDN documentation:

To display a context menu for a notification icon, the current window must be the foreground window before the application calls TrackPopupMenu or TrackPopupMenuEx. Otherwise, the menu will not disappear when the user clicks outside of the menu or the window that created the menu (if it is visible). If the current window is a child window, you must set the (top-level) parent window as the foreground window.

Microsoft 支持对此进行了进一步讨论：

PRB: Menus for Notification Icons Do Not Work Correctly

When you display a context menu for a notification icon (see Shell_NotifyIcon), clicking anywhere besides the menu or the window that created the menu (if it is visible) doesn't cause the menu to disappear. When this behavior is corrected, the second time this menu is displayed, it displays and then immediately disappears.

To correct the first behavior, you need to make the current window the foreground window before calling TrackPopupMenu or TrackPopupMenuEx. If the current window is a child window, set the (top-level) parent window as the foreground window.

The second problem is caused by a problem with TrackPopupMenu. It is necessary to force a task switch to the application that called TrackPopupMenu at some time in the near future. This can be accomplished by posting a benign message to the window or thread.

试试像这样的东西：

var
  SysTrayMenuTicks: DWORD;
  MouseInSysTrayMenu: Boolean;

// drop a TTimer on the TForm at design-time, set its Interval
// property to 100, its Enabled property to false, and assign
// on OnTimer event handler...

procedure TMainForm_1.SysTrayIconMessageHandler(var Msg: TMessage);
var
  Pt: TPoint;
begin
  case Msg.LParam of
    ...
    WM_RBUTTONDOWN:
    begin
      // FYI, the `WM_RBUTTONDOWN` notification provides you with
      // screen coordinates where the popup menu should be displayed,
      // you don't need to use `GetCursorPos()` to figure it out...
      GetCursorPos(Pt);

      SetForegroundWindow(Handle); // <-- bug fix!
      SystemTrayPopUpMenu.PopUp(Pt.X, Pt.Y);
      PostMessage(Handle, WM_NULL, 0, 0); // <-- bug fix!

      SysTrayTimer.Enabled := False;
    end;
    ...
  end;
end;

procedure TMainForm_1.SystemTrayPopUpMenuPopup(Sender: TObject);
begin
  MouseInSysTrayMenu := True;
  SysTrayMenuTicks := GetTickCount;
  SysTrayTimer.Enabled := True;
end;

procedure TMainForm_1.SysTrayTimerTimer(Sender: TObject);
var
  hPopupWnd: HWND;
  R: TRect;
  Pt: TPoint;
begin
  // get the HWND of the current active popup menu...
  hPopupWnd := FindWindow('#32768', nil);
  if hPopupWnd = 0 then Exit;

  // get the popup menu's current position and dimensions...
  GetWindowRect(hPopupWnd, R);

  // get the mouse's current position...
  GetCursorPos(Pt);

  if PtInRect(R, Pt) then
  begin
    // mouse is over the menu...

    if not MouseInSysTrayMenu then
    begin
      // just entered, reset timeout...
      MouseInSysTrayMenu := True;
      SysTrayMenuTicks := GetTickCount;
      Exit;
    end;

    // has the mouse been over the menu for < 5 minutes?
    if (GetTickCount - SysTrayMenuTicks) < 300000 then
      Exit; // yes...

  end else
  begin
    // mouse is not over the menu...

    if MouseInSysTrayMenu then
    begin
      // just left, reset timeout...
      MouseInSysTrayMenu := False;
      SysTrayMenuTicks := GetTickCount;
      Exit;
    end;

    // has the mouse been outside the menu for < 2.5 seconds?
    if (GetTickCount - SysTrayMenuTicks) < 2500 then
      Exit; // yes...

  end;

  // timeout! Close the popup menu...
  SendMessage(PopupList.Window, WM_CANCELMODE, 0, 0);
end;

或者：

var
  MouseInSysTrayMenu: Boolean;

// drop two TTimers on the TForm at design-time, set their Enabled
// properties to false, and assign OnTimer event handlers...

procedure TMainForm_1.SysTrayIconMessageHandler(var Msg: TMessage);
var
  Pt: TPoint;
begin
  case Msg.LParam of
    ...
    WM_RBUTTONDOWN:
    begin
      // FYI, the `WM_RBUTTONDOWN` notification provides you with
      // screen coordinates where the popup menu should be displayed,
      // you don't need to use `GetCursorPos()` to figure it out...
      GetCursorPos(Pt);

      SetForegroundWindow(Handle); // <-- bug fix!
      SystemTrayPopUpMenu.PopUp(Pt.X, Pt.Y);
      PostMessage(Handle, WM_NULL, 0, 0); // <-- bug fix!

      TrackSysTrayMenuTimer.Enabled := False;
      CloseSysTrayMenuTimer.Enabled := False;
    end;
    ...
  end;
end;

procedure TMainForm_1.SystemTrayPopUpMenuPopup(Sender: TObject);
begin
  MouseInSysTrayMenu := True;

  TrackSysTrayMenuTimer.Interval := 100;
  TrackSysTrayMenuTimer.Enabled := True;

  CloseSysTrayMenuTimer.Interval := 300000; // 5 minutes
  CloseSysTrayMenuTimer.Enabled := True;
end;

procedure TMainForm_1.TrackSysTrayMenuTimerTimer(Sender: TObject);
var
  hPopupWnd: HWND;
  R: TRect;
  Pt: TPoint;
begin
  // get the HWND of the current active popup menu...
  hPopupWnd := FindWindow('#32768', nil);
  if hPopupWnd = 0 then Exit;

  // get the popup menu's current position and dimensions...
  GetWindowRect(hPopupWnd, R);

  // get the mouse's current position...
  GetCursorPos(Pt);

  if PtInRect(R, Pt) then
  begin
    // mouse is over the menu...
    if not MouseInSysTrayMenu then
    begin
      // just entered, reset timeout...
      MouseInSysTrayMenu := True;
      CloseSysTrayMenuTimer.Interval := 300000; // 5 minutes
    end;
  end else
  begin
    // mouse is not over the menu...
    if MouseInSysTrayMenu then
    begin
      // just left, reset timeout...
      MouseInSysTrayMenu := False;
      CloseSysTrayMenuTimer.Interval := 2500; // 2.5 seconds
    end;
  end;
end;

procedure TMainForm_1.CloseSysTrayMenuTimerTimer(Sender: TObject);
begin
  // timeout! Close the popup menu...
  CloseSysTrayMenuTimer.Enabled := False;
  SendMessage(PopupList.Window, WM_CANCELMODE, 0, 0);
end;

Answer 2

这样试试：

.....
hPopupWnd := FindWindow('#32768', SystemTrayPopUpMenu);
if hPopupWnd = 0 then Exit;

.....
GetWindowRect(SystemTrayPopUpMenu.Handle, R);

当鼠标指针在弹出菜单外时自动隐藏或关闭弹出菜单 - Delphi

Automatically Hide or Close PopUp Menu when Mouse Pointer is outside it - Delphi

delphi

hide

delphi-2009

popupmenu