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

Question

所以我有一个TMenuItem连接到TAction上TPopupMenu的TDBGrid中（实际上是第三方，但你的想法）。总部设在网格中选择的行上，该TAction启用或禁用。我要的是能够显示一个提示给用户解释为何该项目被禁用。

至于为什么我要在禁用菜单项的提示，让只说我的在与Joel 协议。

所有TMenuItem的有一个提示属性，但作为最好的，我可以告诉他们只用了TApplicationEvent.OnHint事件处理粘暗示在TStatusBar或其他一些特殊的处理。我发现如何创建自己的连窗的文章 TMainMenu的TMenuItems，但它不会对TPopupMenu的TMenuItem工作。它的工作原理通过处理WM_MENUSELECT消息，其据我可以告诉没有在TPopupMenu发送。

Answer 1

WM_MENUSELECT确实为菜单项在弹出菜单通过含有（弹出）菜单形式的窗户PROC处理还可以，但不是，而是由Menus.PopupList创建一个不可见的辅助窗口。幸运的是可以（至少Delphi下5）获得在经由Menus.PopupList.Window此HWND。

现在可以使用老式的方法的子类的窗口，如在本 CodeGear的例如描述文章，处理WM_MENUSELECT也为弹出菜单。的HWND将是有效的从第一TPopupMenu创建到最后TPopupMenu对象被销毁之前后。

一个快速测试与问题的链接文章中的演示应用程序应该透露这是否去上班。

编辑：它确实工作。我改变链接的例子来也显示提示的弹出式菜单。下面是步骤：

添加处理程序的OnDestroy，对于旧的窗口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正确恢复：

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;

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

Answer 2

不知道是否有帮助，但我已经创建了自己的多行提示窗口（为Delphi7），能够表现出更多的则只是一个文本行。 它是开源的，你可以找到它这里。

有是涉及显示在屏幕上的正确的位置了一些工作，但你必须在它的完全控制。