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

So I have a TMenuItem attached to a TAction on a TPopupMenu for a TDBGrid (actually 3rd party, but you get the idea). Based on the selected row in the grid, the TAction is enabled or disabled. What I want is to be able to display a hint to the user explaining why the item is disabled.

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

As far as why I want a hint on a disabled menu item, lets just say I am in agreement with Joel.

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

All TMenuItem's have a hint property, but as best I can tell they are only used the the TApplicationEvent.OnHint event handler to stick the hint in a TStatusBar or some other special processing. I found an article on how to create your own even window for a TMainMenu's TMenuItems, but it doesn't work on a TPopupMenu's TMenuItem. It works by handling the WM_MENUSELECT message, which as far as I can tell is not sent on a TPopupMenu.

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

2 个解决方案

#1

WM_MENUSELECT is indeed handled for menu items in popup menus also, but not by the windows proc of the form containing the (popup) menu, but by an invisible helper window created by Menus.PopupList. Luckily you can (at least under Delphi 5) get at this HWND via Menus.PopupList.Window.

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

Now you can use the old-fashioned way to subclass a window, as described for example in this CodeGear article, to handle WM_MENUSELECT also for popup menus. The HWND will be valid from after the first TPopupMenu is created to before the last TPopupMenu object is destroyed.

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

A quick test with the demo app in the linked article in the question should reveal whether this is going to work.

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

Edit: It does indeed work. I changed the linked example to show hints also for the popup menu. Here are the steps:

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

Add a handler for OnDestroy, a member variable for the old window proc and a method for the new window proc to the form:

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

Change the OnCreate handler of the form to subclass the hidden PopupList window, and implement the proper restoration of the window proc in the OnDestroy handler:

将窗体的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;

Implement the subclassed window proc:

实现子类窗口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;

This is done for all popup menus in a loop, until the first matching item or submenu is found.

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

#2

Not sure if it helps, but I have created my own multi-line hint window (for Delphi7) to be able to show more then just one line of text. It's open source and you can find it here.

不确定它是否有帮助,但我已经创建了我自己的多行提示窗口(对于Delphi7),以便能够显示更多然后只有一行文本。它是开源的,你可以在这里找到它。

There is some work involved showing it on the right location on the screen, but you have full control over it.

有一些工作涉及在屏幕上的正确位置显示它,但您可以完全控制它。

#1