为什么使用 Esc 关闭弹出菜单的著名解决方法不适用于私有句柄?
Why the famous workaround for closing a popup menu with Esc is not working with a private handle?
我在我的应用程序中制作了一个使用托盘图标的组件,当图标显示弹出菜单时,无法使用 Esc 键关闭。然后我找到了 David Heffernan 的解决方法 。我将代码集成到我的组件中,现在可以使用 Esc 关闭菜单,但是在弹出菜单后,我的应用程序变得完全死机,我无法访问主窗体上的任何内容,甚至系统按钮也不再起作用。
这是重现问题的代码:
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, Menus, ShellApi;
const WM_ICONTRAY = WM_USER+1;
type
TForm1 = class(TForm)
PopupMenu1: TPopupMenu;
Test1: TMenuItem;
Test2: TMenuItem;
procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
private
IconData: TNotifyIconData;
protected
procedure PrivateWndProc(var Msg: TMessage); virtual;
public
PrivateHandle:HWND;
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
procedure TForm1.FormCreate(Sender: TObject);
begin
PrivateHandle:=AllocateHWnd(PrivateWndProc);
// add an icon to tray
IconData.cbSize:=SizeOf(IconData);
IconData.Wnd:=PrivateHandle;
IconData.uID:=1;
IconData.uFlags:=NIF_MESSAGE + NIF_ICON;
IconData.uCallbackMessage:=WM_ICONTRAY;
IconData.hIcon:=Application.Icon.Handle;
Shell_NotifyIcon(NIM_ADD, @IconData);
end;
procedure TForm1.FormDestroy(Sender: TObject);
begin
IconData.uFlags:=0;
Shell_NotifyIcon(NIM_DELETE, @IconData);
DeallocateHWnd(PrivateHandle);
end;
procedure TForm1.PrivateWndProc(var Msg: TMessage);
var p:TPoint;
begin
if (Msg.Msg = WM_ICONTRAY) and (Msg.LParam=WM_RBUTTONUP) then
begin
GetCursorPos(p);
SetForegroundWindow(PrivateHandle);
PopupMenu1.Popup(p.x,p.y);
PostMessage(PrivateHandle, WM_NULL, 0, 0);
end;
end;
end.
我猜你只是错过了电话 DefWindowProc。试试这个:
procedure TForm1.PrivateWndProc(var Msg: TMessage);
begin
if (Msg.Msg = WM_ICONTRAY) and (Msg.lParam = WM_RBUTTONUP) then
begin
...
end
else
Msg.Result := DefWindowProc(PrivateHandle, Msg.Msg, Msg.wParam, Msg.lParam);
end;
我在我的应用程序中制作了一个使用托盘图标的组件,当图标显示弹出菜单时,无法使用 Esc 键关闭。然后我找到了 David Heffernan 的解决方法
这是重现问题的代码:
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, Menus, ShellApi;
const WM_ICONTRAY = WM_USER+1;
type
TForm1 = class(TForm)
PopupMenu1: TPopupMenu;
Test1: TMenuItem;
Test2: TMenuItem;
procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
private
IconData: TNotifyIconData;
protected
procedure PrivateWndProc(var Msg: TMessage); virtual;
public
PrivateHandle:HWND;
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
procedure TForm1.FormCreate(Sender: TObject);
begin
PrivateHandle:=AllocateHWnd(PrivateWndProc);
// add an icon to tray
IconData.cbSize:=SizeOf(IconData);
IconData.Wnd:=PrivateHandle;
IconData.uID:=1;
IconData.uFlags:=NIF_MESSAGE + NIF_ICON;
IconData.uCallbackMessage:=WM_ICONTRAY;
IconData.hIcon:=Application.Icon.Handle;
Shell_NotifyIcon(NIM_ADD, @IconData);
end;
procedure TForm1.FormDestroy(Sender: TObject);
begin
IconData.uFlags:=0;
Shell_NotifyIcon(NIM_DELETE, @IconData);
DeallocateHWnd(PrivateHandle);
end;
procedure TForm1.PrivateWndProc(var Msg: TMessage);
var p:TPoint;
begin
if (Msg.Msg = WM_ICONTRAY) and (Msg.LParam=WM_RBUTTONUP) then
begin
GetCursorPos(p);
SetForegroundWindow(PrivateHandle);
PopupMenu1.Popup(p.x,p.y);
PostMessage(PrivateHandle, WM_NULL, 0, 0);
end;
end;
end.
我猜你只是错过了电话 DefWindowProc。试试这个:
procedure TForm1.PrivateWndProc(var Msg: TMessage);
begin
if (Msg.Msg = WM_ICONTRAY) and (Msg.lParam = WM_RBUTTONUP) then
begin
...
end
else
Msg.Result := DefWindowProc(PrivateHandle, Msg.Msg, Msg.wParam, Msg.lParam);
end;