Logo Questions Linux Laravel Mysql Ubuntu Git Menu
 

Display a ToolTip hint on a disabled menu item of a popup menu

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.

As far as why I want a hint on a disabled menu item, lets just say I am in agreement with 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.

like image 754
Jim McKeeth Avatar asked Jan 22 '09 20:01

Jim McKeeth


2 Answers

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.

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.

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:

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:

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:

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.

like image 185
mghie Avatar answered Sep 18 '22 13:09

mghie


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.

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

like image 28
Drejc Avatar answered Sep 20 '22 13:09

Drejc