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

问题描述 投票：0回答：3

所以我有一个 TMenuItem 附加到 TDBGrid 的 TPopupMenu 上的 TAction（实际上是第 3 方，但你明白了）。根据网格中选定的行，启用或禁用 TAction。我想要的是能够向用户显示提示，解释为什么该项目被禁用。

至于为什么我想要有关禁用菜单项的提示，我们只能说我同意 Joel。

所有 TMenuItem 都有一个提示属性，但据我所知，它们仅使用 TApplicationEvent.OnHint 事件处理程序将提示粘贴到 TStatusBar 或其他一些特殊处理中。我找到一篇关于如何为 TMainMenu 的 TMenuItems 创建自己的偶数窗口的文章，但它不适用于 TPopupMenu 的 TMenuItem。它通过处理 WM_MENUSELECT 消息来工作，据我所知，该消息不是在 TPopupMenu 上发送的。

delphi user-interface delphi-2007 tooltip
3个回答
6
投票

WM_MENUSELECT 确实也针对弹出菜单中的菜单项进行处理，但不是由包含（弹出）菜单的窗体的 windows 过程处理，而是由 Menus.PopupList 创建的不可见帮助程序窗口处理。幸运的是，您可以（至少在 Delphi 5 下）通过 Menus.PopupList.Window 获取此 HWND。

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

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

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

在窗体中添加 OnDestroy 的处理程序、旧窗口过程的成员变量和新窗口过程的方法：

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;

对循环中的所有弹出菜单执行此操作，直到找到第一个匹配的项目或子菜单。

3
投票

不确定它是否有帮助，但我创建了自己的多行提示窗口（对于Delphi7），以便能够显示多于一行的文本。 它是开源的，您可以在here找到它。

将其显示在屏幕上的正确位置需要一些工作，但您可以完全控制它。

0
投票

几年前，我在 TForm 派生类中打包了这个不错的解决方案，您可以使用它代替 Tform 在所有弹出菜单中享受提示：

unit UnitMenu;

interface

uses
Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes,     Vcl.Graphics,
Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.Menus, Vcl.StdCtrls,VCL.ExtCtrls,     Vcl.AppEvnts;
//  menuHint;

type

{│}   TMenuItemHint = class(THintWindow)
{│}     private
{│}       activeMenuItem : TMenuItem;
{│}       showTimer : TTimer;
{│}       hideTimer : TTimer;
{│}       procedure HideTime(Sender : TObject) ;
{│}       procedure ShowTime(Sender : TObject) ;
{│}     public
{│}       constructor Create(AOwner : TComponent) ; override;
{│}       destructor Destroy; override;
{│}       procedure DoActivateHint(menuItem : TMenuItem) ;
{│}    end;

  TFormMenuHint = class(TForm)
    ApplicationEventsMenu: TApplicationEvents;
    procedure ApplicationEventsMenuHint(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
  private
    { Private declarations }
    //menuhint members
{│} miHint : TMenuItemHint;
{│} fOldWndProc: TFarProc;
    procedure PopupListWndProc(var AMsg: TMessage);
  public
    { Public declarations }
  end;

var
  Form8: TFormMenuHint;

implementation

{$R *.dfm}
{│} procedure TMenuItemHint.HideTime(Sender: TObject);
{│} begin
{│}    //hide (destroy) hint window
{│}    self.ReleaseHandle;
   if assigned(hidetimer) then
   begin
{│}     hideTimer.OnTimer := nil;
    freeandnil(hidetimer);
   end;
{│} end;
{│} procedure TMenuItemHint.ShowTime(Sender: TObject);
{│}
{│}   procedure Split(Delim: Char; Str: string; Lst: TStrings) ;
{│}   begin
{│}      Lst.Clear;
{│}      Lst.StrictDelimiter := True;
{│}      Lst.Delimiter     := Delim;
{│}      Lst.DelimitedText := Str;
{│}   end;
{│}
{│} var
{│}   r : TRect;
{│}   wdth : integer;
{│}   list : TStringList;
{│}   s,str  : string;
{│}   j,h,w : integer;
{│}
{│} begin
{│}   if activeMenuItem <> nil then
{│}   begin
{│}      str := activeMenuItem.Hint;
{│}      str := StringReplace(str,#13#10,'|',[rfReplaceAll]);
{│}      str := StringReplace(str,#13,'|',[rfReplaceAll]);
{│}      str := StringReplace(str,#10,'|',[rfReplaceAll]);
{│}      while AnsiPos('||',str) > 0 do
{│}      begin
{│}        str := StringReplace(str,'||','|',[]);
{│}      end;
{│}
{│}      list := TStringList.Create;
{│}      split('|',str,list);
{│}      s := '';
{│}      h := Canvas.TextHeight(str) * (list.Count);
{│}      w := 0;
{│}      for j := 0 to list.Count -1 do
{│}      begin
{│}        if j > 0 then s := s + #13#10;
{│}        s := s + list[j];
{│}        wdth := Canvas.TextWidth(list[j]);
{│}        if wdth > w then w := wdth;
{│}      end;
{│}      list.Free;
{│}
{│}     //position and resize
{│}     r.Left := Mouse.CursorPos.X;
{│}     r.Top := Mouse.CursorPos.Y + 20;
{│}     r.Right := r.Left + w + 8;
{│}     r.Bottom := r.Top + h + 2;//6;
{│}     ActivateHint(r,s);
{│}   end;
{│}
{│}   showTimer.OnTimer := nil;
  hideTimer := TTimer.Create(self) ;
  hideTimer.OnTimer := HideTime;
  hidetimer.Interval:=50*length(s);
{│} end; (*ShowTime*)
{├─────────────────────────────────────────────────────────────}
{│} constructor TMenuItemHint.Create(AOwner: TComponent);
{│} begin
{│}   inherited;
{│}   showTimer := TTimer.Create(self) ;
{│}   showTimer.Interval := Application.HintPause;
{│}
{│}//   hideTimer := TTimer.Create(self) ;
{│}//   hideTimer.Interval := Application.HintHidePause;
{│} end;
{├─────────────────────────────────────────────────────────────}
{│} destructor TMenuItemHint.Destroy;
{│} begin
{│}   hidetimer.free;//hideTimer.OnTimer := nil;
{│}   showTimer.free;//showTimer.OnTimer := nil;
{│}   self.ReleaseHandle;
{│}   inherited;
{│} end;
{├─────────────────────────────────────────────────────────────}
{│} procedure TMenuItemHint.DoActivateHint(menuItem: TMenuItem);
{│} begin
{│}   //force remove of the "old" hint window
{│}   hideTime(self) ;
{│}
{│}   if (menuItem = nil) or (menuItem.Hint = '') then
{│}   begin
{│}     activeMenuItem := nil;
{│}     Exit;
{│}   end;
{│}
{│}   activeMenuItem := menuItem;
{│}
{│}   showTimer.OnTimer := ShowTime;
{│}   //hideTimer.OnTimer := HideTime;
{│} end;
{├────────────────────────────────────────────────────────────┐}

{│} procedure TFormMenuHint.ApplicationEventsMenuHint(Sender: TObject);
var
 ms:Tpoint;
 mitem,i:integer;
 NewWndProc: TFarProc;
 popupmenu:Tpopupmenu;
begin
 getcursorpos(ms);
 mitem:=-1;
 for i:=0 to ComponentCount-1 do
  if components[i] is Tpopupmenu then begin
    popupmenu:=Tpopupmenu(components[i]);
    mitem:=MenuItemFromPoint(0,Tpopupmenu(components[i]).Handle,ms);
    if mitem>=0 then
     break;
  end;
 if mitem<0 then
    exit;
 if not assigned(miHint) then begin
   mihint:=Tmenuitemhint.create(self);
   NewWndProc := MakeObjectInstance(PopupListWndProc);
   fOldWndProc := TFarProc(SetWindowLong(VCL.Menus.PopupList.Window, GWL_WNDPROC,
        nativeint(NewWndProc))); //11.3
 end;
 miHint.DoActivateHint(popupmenu.items[mItem]);
end;

procedure TFormMenuHint.FormDestroy(Sender: TObject);
{│} var
{│}   NewWndProc: TFarProc;
{│} begin
  if not assigned(mihint) then  exit;
{│}   NewWndProc := TFarProc(SetWindowLong(VCL.Menus.PopupList.Window, GWL_WNDPROC,
         nativeint(fOldWndProc))); //11.3
{│}   FreeObjectInstance(NewWndProc);
  freeandnil(mihint);
{│} end;

procedure TFormMenuHint.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, VCL.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;

end.

几周前，我不得不从 Embarcadero Delphi 10.3 迁移到 Delphi 11.3（我的 CE lysense 已过期）。试图稍微改变我的旧项目，我重建了它并得到了一个丑陋的错误：user32.dll 深处的访问冲突。我花了一品脱血才找到两个石膏：

integer(NewWndProc) in FormCreate and
integer(fOldWndProc) in FormDestroy

在 10.3 中以 64 位运行，在 11.3 中变为 32 位。使用nativeint()代替

最新问题
© www.soinside.com 2019 - 2024. All rights reserved.