Автоматическое скрытие или закрытие меню PopUp, когда указатель мыши находится за его пределами - Delphi

Question

У меня есть PopupMenu в моем приложении, которое появляется, когда пользователь щелкает правой кнопкой мыши значок моего приложения.

Когда я щелкаю правой кнопкой мыши по этому значку, всплывающее меню и ничего не делаю, мое приложение ведет себя как возобновление своей работы, потому что похоже, что оно ждет, пока я нажму на элемент меню.

Я хочу удалить это поведение. Я попытался установить PopupMenu, добавив процедуру Auto-Close, когда от пользователя не приходит ответ, и когда указатель мыши покидает PopupMenu.

Я также попытался добавить TTimer, который закрывает мой TPopUpMenu через определенное время, но закрывается после указанного мной времени, не глядя, указатель мыши находится внутри или вне PopupMenu.

два сценария я хочу достичь являются:

• Я хочу TPopUpMenu закрыть, когда пользователь перемещает указатель мыши из него более двух-трех секунд.

• Когда пользователь перемещает указатель мыши внутри него, то TPopupMenu должен быть закрыт после того, как пять минут, потому что какой-либо пользователь должен ответить на PopupMenu в течение пяти минут.

Я попытался добавить следующий код с TTimer обработчик события моего приложения, что открывает PopupMenu, когда правая кнопка мыши пользователя на Tray Icon, но 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 используются в MainForm экране приложения:

Как присвоенного TrackSysTrayMenuTimer значения свойств .....

Как я присвоил CloseSysTrayMenuTimer «s значения свойств .....

Я также получил Exception сообщение, как это .....

Это сообщение, которое я написал, как это, чтобы проверить, что происходит сбой в Кодексе ..... Так что с этим я могу определить, если 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

Стандартное всплывающее меню не должно автоматически закрываться, когда пользователь перемещает мышь за ее пределы. Пользователь должен щелкнуть где-нибудь, чтобы отклонить его.

Если вы действительно хотите автоматически закрыть всплывающее меню, когда мышь перемещается за его пределы, вам нужно вручную реализовать собственное отслеживание, чтобы узнать, когда мышь находится за пределами текущих отображаемых координат меню.

Это, как говорится, есть ошибка в коде, который вам нужно исправить. Per MSDN documentation:

Чтобы отобразить контекстное меню для значка уведомления, текущего окна должно быть окном переднего плана перед тем как приложение вызывает TrackPopupMenu или TrackPopupMenuEx. В противном случае, меню не исчезнет, ​​когда пользователь нажимает кнопку за пределами меню или окно, в котором создано меню (если оно видно). Если текущее окно является дочерним окном, вы должны установить родительское окно верхнего уровня как окно переднего плана.

Это дальнейшее обсуждение по Microsoft Support:

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