当鼠标指针在弹出菜单之外时自动隐藏或关闭弹出菜单 - 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：

要显示通知图标的上下文菜单，当前窗口必须是前景窗口，然后应用程序才会调用 TrackPopupMenu 或 TrackPopupMenuEx。否则，当用户在菜单或创建菜单的窗口之外单击时，菜单不会消失（如果可见）。如果当前窗口是子窗口，则必须将（顶层）父窗口设置为前台窗口。

这是微软支持部门的进一步讨论：

PRB: Menus for Notification Icons Do Not Work Correctly

当您显示通知图标的上下文菜单（请参阅 Shell_NotifyIcon）时，单击菜单或创建菜单的窗口（如果可见）之外的任何位置不会导致菜单消失。纠正此行为后，第二次显示此菜单时，它会显示然后立即消失。

要纠正第一个行为，您需要在调用 TrackPopupMenu 或 TrackPopupMenuEx 之前使当前窗口成为前景窗口。如果当前窗口是子窗口，则将（顶层）父窗口设置为前台窗口。

第二个问题是由 TrackPopupMenu 的问题引起的。有必要在不久的将来某个时间强制将任务切换到调用 TrackPopupMenu 的应用程序。这可以通过将良性消息发布到窗口或线程来完成。

试试这样的：

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);