在弹出菜单的禁用菜单项上显示工具提示提示

所以我有一个TMenuItem附加到TPopupMenu上的TAction为TDBGrid(实际上是第三方,但你明白了).根据网格中选定的行,启用或禁用TAction.我想要的是能够向用户显示提示,解释禁用该项目的原因.

至于为什么我想要一个关于禁用的菜单项的提示,我只想说我与Joel达成协议.

所有TMenuItem都有一个提示属性,但我最好告诉他们只使用TApplicationEvent.OnHint事件处理程序将提示粘贴在TStatusBar或其他一些特殊处理中.我发现了一篇关于如何为TMainMenu的TMenuItems创建自己的窗口的文章,但它不适用于TPopupMenu的TMenuItem.它的工作原理是处理WM_MENUSELECT消息,据我所知,它不是在TPopupMenu上发送的.

WM_MENUSELECT确实也用于弹出菜单中的菜单项,但不是由包含(弹出)菜单的窗体的窗口proc处理,而是由Menus.PopupList创建的隐形辅助窗口处理.幸运的是,你可以(至少在Delphi 5下)通过Menus.PopupList.Window获得此HWND.

现在,您可以使用老式的方法对窗口进行子类化,如此CodeGear文章中所述,也可以为弹出菜单处理WM_MENUSELECT.从创建第一个TPopupMenu到销毁最后一个TPopupMenu对象之前,HWND将有效.

在问题中的链接文章中使用演示应用程序进行快速测试应该会发现这是否有效.

编辑:确实有效.我更改了链接的示例以显示弹出菜单的提示.以下是步骤:

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

实现子类窗口proc:

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;

这是针对循环中的所有弹出菜单完成的,直到找到第一个匹配项或子菜单.