I want to display a form when the cursor enters the icon, and it disappears shortly after the cursor leaves the icon, similar to the Process Hacker software.
(It displays a form above the system tray that displays information about running applications when the cursor enters the icon, with additional options such as attaching the form that will not disappear, opening settings and more, and the form disappears a few seconds after leaving the icon)
I saw this post
Edit:
I do not need to add these events as properties (like the built-in OnMouseMove, and as in TTrayIconEx), I just want to add a handler procedure that will receive the messages sent from the icon when the cursor hovers over it or leaves it. For example, the messages Remy Lebeau mentioned in his reply (NIN_POPUPOPEN
, NIN_POPUPCLOSE
)
Is this possible, and how?
updating:
In fact, I used this code as experience:
unit MainFormtest;
interface
uses
ShellAPI, Windows, Messages, SysUtils, Classes,
Vcl.Controls, Vcl.Forms, Vcl.ExtCtrls, Vcl.Menus;
type
TTesterForm = class(TForm)
DelayHide: TTimer;
TestPopupMenu: TPopupMenu;
PMClose: TMenuItem;
procedure FormCreate(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure DelayHideTimer(Sender: TObject);
procedure FormMouseEnter(Sender: TObject);
procedure FormMouseLeave(Sender: TObject);
procedure FormHide(Sender: TObject);
procedure PMCloseClick(Sender: TObject);
procedure TestPopupMenuPopup(Sender: TObject);
protected
procedure CreateParams(var Params: TCreateParams); override;
public
TrayIconForTest: TNotifyIconData;
procedure TrayMouseMessage(var Msg: TMessage); Message WM_SYSTEM_TRAY_MESSAGE;
end;
var
TesterForm: TTesterForm;
implementation
{$R *.dfm}
procedure TTesterForm.FormCreate(Sender: TObject);
begin
with TrayIconForTest do
begin
cbSize := TNotifyIconData.SizeOf;
Wnd := Handle;
uID := $20;
uFlags := NIF_MESSAGE or NIF_ICON or NIF_TIP;
uCallBackMessage := WM_SYSTEM_TRAY_MESSAGE;
hIcon := Application.Icon.Handle;
szTip := 'this is test icon';
uVersion := 4;
dwInfoFlags := NIIF_USER;
hBalloonIcon := Application.Icon.Handle;
end;
Shell_NotifyICon(NIM_ADD, @TrayIconForTest);
Shell_NotifyIcon(NIM_SETVERSION, @TrayIconForTest);
end;
procedure TTesterForm.CreateParams(var Params: TCreateParams);
begin
inherited;
Params.ExStyle := Params.ExStyle and not WS_EX_APPWINDOW;
Params.WndParent := Application.Handle;
end;
procedure TTesterForm.TestPopupMenuPopup(Sender: TObject);
begin
DelayHide.Enabled := False;
end;
procedure TTesterForm.TrayMouseMessage(var Msg: TMessage);
begin
case LOWORD(Msg.Lparam) of
NIN_POPUPOPEN:
begin
TesterForm.Show;
DelayHide.Enabled := False;
TestPopupMenu.CloseMenu;
end;
NIN_POPUPCLOSE:
DelayHide.Enabled := True;
WM_RBUTTONDOWN, WM_LBUTTONDOWN:
TestPopupMenu.Popup(Mouse.CursorPos.X, Mouse.CursorPos.Y);
end;
end;
procedure TTesterForm.DelayHideTimer(Sender: TObject);
begin
TesterForm.Hide;
end;
procedure TTesterForm.FormClose(Sender: TObject; var Action: TCloseAction);
begin
Shell_NotifyIcon(NIM_DELETE, @TrayIconForTest);
Application.Terminate;
end;
procedure TTesterForm.FormHide(Sender: TObject);
begin
DelayHide.Enabled := False;
end;
procedure TTesterForm.FormMouseEnter(Sender: TObject);
begin
DelayHide.Enabled := False;
end;
procedure TTesterForm.FormMouseLeave(Sender: TObject);
begin
DelayHide.Enabled := True;
end;
procedure TTesterForm.PMCloseClick(Sender: TObject);
begin
testerForm.Close;
end;
end.
But he suffers from several problems:
- When I press the right / left button to open the menu, the message
NIN_POPUPCLOSE
is not read again until the cursor enters the icon again and exits. - The menu does not close when a mouse button is pressed anywhere (so I added
TestPopupMenu.CloseMenu
to close the menu when the cursor re-enters). - The form window tends to display in the back when targeting another application window. I tried applying
TesterForm.BringToFront
and alsoSetForegroundWindow
and it did not help.
Can you direct me to fix the code?