1. 技术文章
  2. Automatically Hide or Close PopUp Menu when Mouse Pointer is outside it - Delphi

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

由 纵然是瞬间 提交于 2019-12-23 05:18:00

问题


I have a PopupMenu in my Application which pops up when a user right clicks on my App's Notification Area icon.

When I right click on this icon, pop up the menu, and do nothing, my App behaves like resuming its work because it looks like it is waiting until I click on a Menu Item.

I want to remove this behavior. I tried fixing the PopupMenu by adding an Auto-Close procedure when no response comes from the user and when the Mouse Pointer leaves the PopupMenu.

I also tried adding a TTimer that closes my TPopUpMenu after a specified time, but it closes after the time I specified without looking if the Mouse Pointer is inside or outside the PopupMenu.

Two Scenarios I want to Achieve are:

  • I want the TPopUpMenu to close when the user moves the Mouse Pointer out of it for more than two or three seconds.

  • When the user moves the Mouse Pointer inside of it, the TPopupMenu should be closed after five minutes, because ANY USER should respond to a PopupMenu within five minutes.

I tried adding the following code with a TTimer to my App's Event Handler that opens the PopupMenu when the user right-clicks on the Tray Icon, but the PopupMenu always closes after two seconds:

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;

I also read this, but after I added the code, nothing changed.

At least, I must be able to do this: close the PopupMenu after the user opens it by right clicking and moves the Mouse Pointer outside of it.

This is how I added new code to achieve this:

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;

How two TTimers are used in the App's MainForm:

How I assigned TrackSysTrayMenuTimer's property values.....

How I assigned CloseSysTrayMenuTimer's property values.....

I also got an Exception Message like this.....

It is a message I wrote like this to check what is failing in the Code..... So with that I can identify if FindWindow is failing or not.....

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

The Last Error I received is:

Thanks in Advance.


回答1:


A standard popup menu is not supposed to auto-close when the user moves the mouse outside of it. The user is meant to click somewhere to dismiss it.

If you really want to auto-close a popup menu when the mouse moves outside of it, you have to manually implement your own tracking to know when the mouse is outside of the menu's current display coordinates.

That being said, there is also a bug in your code that you need to fix. Per 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.

This is further discussion by Microsoft Support:

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.

Try something more like this:

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;

Alternatively:

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;



回答2:


Try like this:

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

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


来源：https://stackoverflow.com/questions/38739794/automatically-hide-or-close-popup-menu-when-mouse-pointer-is-outside-it-delphi

标签
Delphi
hide
delphi-2009
popupmenu
易学教程内所有资源均来自网络或用户发布的内容，如有违反法律规定的内容欢迎反馈！
该文章没有解决你所遇到的问题?点击提问,说说你的问题,让更多的人一起探讨吧!