WM_MENUSELECT 确实也用于弹出菜单中的菜单项,但不是由包含(弹出)菜单的窗体的 windows proc 处理,而是由 Menus.PopupList 创建的不可见帮助窗口处理。幸运的是,您可以(至少在 Delphi 5 下)通过 Menus.PopupList.Window 获得这个 HWND。
现在您可以使用老式方法对窗口进行子类化,例如在此CodeGear article 中描述的那样,也可以为弹出菜单处理 WM_MENUSELECT。 HWND在第一个TPopupMenu创建后到最后一个TPopupMenu对象销毁前有效。
对问题中链接文章中的演示应用进行快速测试,应该会发现这是否可行。
编辑:确实有效。我更改了the linked example 以显示弹出菜单的提示。步骤如下:
为表单添加一个 OnDestroy 的处理程序、一个旧窗口 proc 的成员变量和一个新窗口 proc 的方法:
TForm1 = class(TForm)
...
procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
procedure ApplicationEvents1Hint(Sender: TObject);
private
miHint : TMenuItemHint;
fOldWndProc: TFarProc;
procedure WMMenuSelect(var Msg: TWMMenuSelect); message WM_MENUSELECT;
procedure PopupListWndProc(var AMsg: TMessage);
end;
改变窗体的 OnCreate 处理程序以子类化隐藏的 PopupList 窗口,并在 OnDestroy 处理程序中实现窗口 proc 的正确恢复:
procedure TForm1.FormCreate(Sender: TObject);
var
NewWndProc: TFarProc;
begin
miHint := TMenuItemHint.Create(self);
NewWndProc := MakeObjectInstance(PopupListWndProc);
fOldWndProc := TFarProc(SetWindowLong(Menus.PopupList.Window, GWL_WNDPROC,
integer(NewWndProc)));
end;
procedure TForm1.FormDestroy(Sender: TObject);
var
NewWndProc: TFarProc;
begin
NewWndProc := TFarProc(SetWindowLong(Menus.PopupList.Window, GWL_WNDPROC,
integer(fOldWndProc)));
FreeObjectInstance(NewWndProc);
end;
实现子类窗口过程:
procedure TForm1.PopupListWndProc(var AMsg: TMessage);
function FindItemForCommand(APopupMenu: TPopupMenu;
const AMenuMsg: TWMMenuSelect): TMenuItem;
var
SubMenu: HMENU;
begin
Assert(APopupMenu <> nil);
// menuitem
Result := APopupMenu.FindItem(AMenuMsg.IDItem, fkCommand);
if Result = nil then begin
// submenu
SubMenu := GetSubMenu(AMenuMsg.Menu, AMenuMsg.IDItem);
if SubMenu <> 0 then
Result := APopupMenu.FindItem(SubMenu, fkHandle);
end;
end;
var
Msg: TWMMenuSelect;
menuItem: TMenuItem;
MenuIndex: integer;
begin
AMsg.Result := CallWindowProc(fOldWndProc, Menus.PopupList.Window,
AMsg.Msg, AMsg.WParam, AMsg.LParam);
if AMsg.Msg = WM_MENUSELECT then begin
menuItem := nil;
Msg := TWMMenuSelect(AMsg);
if (Msg.MenuFlag <> $FFFF) or (Msg.IDItem <> 0) then begin
for MenuIndex := 0 to PopupList.Count - 1 do begin
menuItem := FindItemForCommand(PopupList.Items[MenuIndex], Msg);
if menuItem <> nil then
break;
end;
end;
miHint.DoActivateHint(menuItem);
end;
end;
对循环中的所有弹出菜单执行此操作,直到找到第一个匹配项或子菜单。