Question

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

当我右键单击此图标，弹出菜单，什么都不做时，我的应用程序就像恢复它的工作一样，因为它看起来好像等到我点击菜单项。

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

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

我想要实现的两个方案是：

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

我尝试将以下代码与TTimer一起添加到我应用的事件处理程序中，当用户右键单击托盘图标时打开PopupMenu，但PopupMenu会在两秒后关闭：< / p>

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;

如何在App的主要框架中使用两个TTimers：

我如何分配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之前显示通知图标的上下文菜单，当前窗口必须是前台窗口。否则，当用户点击菜单外部或创建菜单的窗口（如果可见）时，菜单不会消失。如果当前窗口是子窗口，则必须将（顶级）父窗口设置为前景窗口。

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

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

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

2 个答案: