当鼠标指针在菜单外时自动隐藏或关闭弹出菜单-Delphi [英] Automatically Hide or Close PopUp Menu when Mouse Pointer is outside it - Delphi
问题描述
我的应用程序中有一个PopupMenu，当用户右键单击我的应用程序的通知区域图标时会弹出该菜单。
当我右键单击该图标，弹出菜单，什么也不做时，我的App就像恢复工作一样，因为它看起来一直在等待，直到单击为止。菜单项。
我要删除此行为。当用户没有响应并且鼠标指针离开PopupMenu时，我尝试通过添加自动关闭过程来修复PopupMenu。
我还尝试添加 TTimer 在指定时间后关闭我的 TPopUpMenu ，但在我指定的时间后关闭，而无需查看鼠标指针是否在其中或在PopupMenu之外。
我要实现的两个方案是：
-
我希望
TPopUpMenu在用户将鼠标指针移出鼠标两秒钟或三秒钟以上时关闭。 -
当用户将鼠标指针移入其中时，
TPopupMenu应该在五分钟后关闭，因为任何用户都应在五分钟内响应PopupMenu。
我尝试将带有 TTimer 的以下代码添加到我的应用程序的事件处理程序中，该事件处理程序在使用时会打开PopupMenu r右键单击托盘图标，但是PopupMenu总是在两秒钟后关闭：
过程TMainForm_1.SysTrayIconMessageHandler（var Msg： TMessage）;
var
SysTrayTimer：TTimer；
PT：TPoint；
开始
案件Msg.LParam of
WM _.....：;
WM_RBUTTONDOWN：
开始
GetCursorPos（PT）;
SysTrayTimer.Enabled：=真;
SysTrayTimer.Interval：= 2500;
SystemTrayPopUpMenu.PopUp（PT.X，PT.Y）;
SystemTrayPopUpMenu.AutoLineReduction：= maAutomatic;
结尾；
结尾；
结尾；
过程TMainForm_1.OnSysTrayTimer（Sender：TObject）;
开始
SysTrayTimer.Enabled：= False;
SendMessage（PopupList.Window，WM_CANCELMODE，0，0）;
结尾；
我还阅读了
我如何分配 TrackSysTrayMenuTimer 的属性值.....
我如何分配 CloseSysTrayMenuTimer 的属性值.....
我也遇到了异常这样的消息.....
这是一条我写过的消息，用于检查代码中出现了什么问题.....我可以确定 FindWindow 是否失败.....
...
hPopupWnd：= FindWindow（'＃32768'，nil）;
如果hPopupWnd = 0，则
开始
TrackSysTrayMenuTimer.Enabled：= False;
如果ShowErrors = True且TestingMode = True，则
Application.MessageBox（'找不到弹出菜单 SystemTrayPopUpMenu。+
'FindWindow将中止。'，'异常消息' ，MB_ICONSTOP或MB_OK）；
出口；
我收到的最后一个错误是：
在此先感谢。
当用户将鼠标移出标准弹出菜单时，该弹出菜单不应自动关闭。
如果您真的想在鼠标移到弹出菜单之外时自动关闭弹出菜单，则必须手动执行您自己进行跟踪，以了解何时鼠标不在菜单的当前显示坐标之外。
话虽这么说，您的代码中还有一个错误需要修复。根据 MSDN文档：
要显示通知图标的上下文菜单，在应用程序调用TrackPopupMenu或TrackPopupMenuEx之前，当前窗口必须是前景窗口。否则，当用户在菜单或创建菜单的窗口之外单击时，菜单不会消失（如果可见）。如果当前窗口是子窗口，则必须将（顶级）父窗口设置为前景窗口。
Microsoft支持人员进行的进一步讨论：
当您显示通知图标的上下文菜单时（请参见Shell_NotifyIcon） ，单击菜单或创建菜单的窗口（如果可见）旁边的任何位置都不会导致菜单消失。纠正此问题后，第二次显示此菜单，它将显示，然后立即消失。
要更正第一个行为，您需要在调用TrackPopupMenu或TrackPopupMenuEx之前将当前窗口作为前景窗口。如果当前窗口是子窗口，则将（顶级）父窗口设置为前景窗口。
第二个问题是由TrackPopupMenu问题引起的。在不久的将来的某个时候，有必要强制将任务切换到名为TrackPopupMenu的应用程序。这可以通过将良性消息发布到窗口或线程来完成。
尝试其他类似方法：
var
SysTrayMenuTicks：DWORD;
MouseInSysTrayMenu：布尔值；
//在设计时在TForm上放置一个TTimer，将其Interval
//属性设置为100，将其Enabled属性设置为false，并在OnTimer上分配
//事件处理程序...
过程TMainForm_1.SysTrayIconMessageHandler（var Msg：TMessage）;
var
Pt：TPoint；
开始
案例
的Msg.Laram ...
WM_RBUTTONDOWN：
开始
//仅供参考，`WM_RBUTTONDOWN`通知为您提供
//应该显示弹出菜单的屏幕坐标，
//您不需要使用`GetCursorPos（）`来解决...
GetCursorPos（Pt）;
SetForegroundWindow（Handle）; //<-错误修复！
SystemTrayPopUpMenu.PopUp（Pt.X，Pt.Y）;
PostMessage（句柄，WM_NULL，0，0）; //<-错误修复！
SysTrayTimer.Enabled：= False;
结尾；
...
结尾；
结尾；
过程TMainForm_1.SystemTrayPopUpMenuPopup（Sender：TObject）;
开始
MouseInSysTrayMenu：= True;
SysTrayMenuTicks：= GetTickCount;
SysTrayTimer.Enabled：=真;
结尾；
过程TMainForm_1.SysTrayTimerTimer（Sender：TObject）;
var
hPopupWnd：HWND;
R：TRect；
点：TPoint；
begin
//获取当前活动弹出菜单的HWND ...
hPopupWnd：= FindWindow（’＃32768’，nil）;
如果hPopupWnd = 0，则退出；
//获取弹出菜单的当前位置和尺寸...
GetWindowRect（hPopupWnd，R）;
//获取鼠标的当前位置...
GetCursorPos（Pt）;
如果PtInRect（R，Pt）然后
开始
//鼠标悬停在菜单上...
如果没有MouseInSysTrayMenu然后
开始
// //刚刚输入，重置超时...
MouseInSysTrayMenu：= True;
SysTrayMenuTicks：= GetTickCount;
出口；
结尾；
//将鼠标悬停在< 5分钟？
if（GetTickCount-SysTrayMenuTicks）< 300000然后
退出; //是...
结束，否则
开始
//鼠标不在菜单上...
如果MouseInSysTrayMenu然后
开始
// //刚离开，重置超时...
MouseInSysTrayMenu：= False;
SysTrayMenuTicks：= GetTickCount;
出口；
结尾；
//鼠标是否位于< 2.5秒？
if（GetTickCount-SysTrayMenuTicks）< 2500，然后
退出； //是...
结尾；
//超时！关闭弹出菜单...
SendMessage（PopupList.Window，WM_CANCELMODE，0，0）;
结尾；
或者：
var
MouseInSysTrayMenu：布尔值；
//在设计时在TForm上放置两个TTimer，将其Enabled
//属性设置为false，然后分配OnTimer事件处理程序...
过程TMainForm_1.SysTrayIconMessageHandler（var Msg：TMessage）;
var
Pt：TPoint；
开始
案例
的Msg.Laram ...
WM_RBUTTONDOWN：
开始
//仅供参考，`WM_RBUTTONDOWN`通知为您提供
//应该显示弹出菜单的屏幕坐标，
//您不需要使用`GetCursorPos（）`来解决...
GetCursorPos（Pt）;
SetForegroundWindow（Handle）; //<-错误修复！
SystemTrayPopUpMenu.PopUp（Pt.X，Pt.Y）;
PostMessage（句柄，WM_NULL，0，0）; //<-修正错误！
TrackSysTrayMenuTimer.Enabled：= False;
CloseSysTrayMenuTimer.Enabled：=否;
结尾；
...
结尾；
结尾；
过程TMainForm_1.SystemTrayPopUpMenuPopup（Sender：TObject）;
开始
MouseInSysTrayMenu：= True;
TrackSysTrayMenuTimer.Interval：= 100;
TrackSysTrayMenuTimer.Enabled：= True;
CloseSysTrayMenuTimer.Interval：= 300000; // 5分钟
CloseSysTrayMenuTimer.Enabled：= True;
结尾；
过程TMainForm_1.TrackSysTrayMenuTimerTimer（Sender：TObject）;
var
hPopupWnd：HWND;
R：TRect；
点：TPoint；
begin
//获取当前活动弹出菜单的HWND ...
hPopupWnd：= FindWindow（’＃32768’，nil）;
如果hPopupWnd = 0，则退出；
//获取弹出菜单的当前位置和尺寸...
GetWindowRect（hPopupWnd，R）;
//获取鼠标的当前位置...
GetCursorPos（Pt）;
如果PtInRect（R，Pt）然后
开始
//鼠标悬停在菜单上...
如果没有MouseInSysTrayMenu然后
开始
//刚刚输入，重置超时...
MouseInSysTrayMenu：= True;
CloseSysTrayMenuTimer.Interval：= 300000; // 5分钟
结束；
结束，否则
开始
//鼠标不在菜单上...
如果MouseInSysTrayMenu则
开始
//刚离开，重置超时。 ..
MouseInSysTrayMenu：= False;
CloseSysTrayMenuTimer.Interval：= 2500; // 2.5秒
结束；
结尾；
结尾；
过程TMainForm_1.CloseSysTrayMenuTimerTimer（Sender：TObject）;
开始
//超时！关闭弹出菜单...
CloseSysTrayMenuTimer.Enabled：= False;
SendMessage（PopupList.Window，WM_CANCELMODE，0，0）;
结尾；
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
TPopUpMenuto 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
TPopupMenushould 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.
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;
这篇关于当鼠标指针在菜单外时自动隐藏或关闭弹出菜单-Delphi的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！
