Wow did I under estimate what it takes to pull this one off.
It turns out that menuitem hints by design are intended to display in the status bar. Who's bright idea was that? I don't know about you but when I mouseover stuff my eyes look where the mouse cursor is. I hardly ever look down at the status bar.
So, I turned to google and began my search for code. I figured that someone has already done this and I can just implement their solution. Almost but not quite.
Here are my requirements:
- Display all main menu hints in a tooltip
- Display all popup menu hints in a tooltip
- Display multi-line menu hints as multi-lines
How to Display Menu Item Hints in Delphi Applications - Zarko Gajic
Display a ToolTip hint on a disabled menu item of a popup menu - mghie
I have heavily commented the code below for a very specific reason. I wanted it to standout from all the other code in my application. Here is what the folded code looks like in my IDE
Semper Fi,
Gunny Mike
Add to Uses
Vcl.Menus
Vcl.ExtCtrls
Interface Section
{┌────────────────────────────────────────────────────────────┐}
{│ MenuHints Type Declaration │}
{├────────────────────────────────────────────────────────────┤}
{│ How to Display Menu Item Hints in Delphi Applications │}
{│ http://delphi.about.com/od/vclusing/a/menuitemhints.htm │}
{│ Zarko Gajic │}
{├────────────────────────────────────────────────────────────┘}
{│} 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;
{│} { End TMenuItemHint }
{└─────────────────────────────────────────────────────────────}
TForm Private Declarations
{ Private declarations }
{┌────────────────────────────────────────────────────────────┐}
{│ MenuHints Form Private Declartions │}
{├────────────────────────────────────────────────────────────┤}
{│ Adapted from Zarko Gajic's article called │}
{│ How to Display Menu Item Hints in Delphi Applications │}
{│ http://delphi.about.com/od/vclusing/a/menuitemhints.htm │}
{│ │}
{│ Further adapted by mghie's stackoverflow answer to │}
{│ Display a ToolTip hint on a disabled menu item of a │}
{│ popup menu │}
{│ http://stackoverflow.com/questions/470696/#471065 │}
{│ │}
{│ Important: │}
{│ Add call to MenuHintOnCreate in the form OnCreate method │}
{│ Add call to MenuHintOnDestroy in the form OnDestroy method │}
{├────────────────────────────────────────────────────────────┘}
{│} miHint : TMenuItemHint;
{│} fOldWndProc: TFarProc;
{└─────────────────────────────────────────────────────────────}
{┌────────────────────────────────────────────────────────────┐}
{│ MenuHints Form Private Declartions Contiinued │}
{├────────────────────────────────────────────────────────────┘}
{│} Procedure MenuHintOnCreate;
{│} Procedure MenuHintOnDestroy;
{│} procedure WMMenuSelect(var Msg: TWMMenuSelect); message WM_MENUSELECT;
{│} procedure PopupListWndProc(var AMsg: TMessage); public
{└─────────────────────────────────────────────────────────────}
Form OnCreate / OnDestroy
procedure TfrmMain.FormCreate(Sender: TObject);
begin
{┌────────────────────────────────────────────────────────────┐}
{│ MenuHints: │}
{├────────────────────────────────────────────────────────────┘}
{│} MenuHintOnCreate;
{└─────────────────────────────────────────────────────────────}
end;
procedure TfrmMain.FormDestroy(Sender: TObject);
begin
{┌────────────────────────────────────────────────────────────┐}
{│ MenuHints: │}
{├────────────────────────────────────────────────────────────┘}
{│} MenuHintOnDestroy;
{└─────────────────────────────────────────────────────────────}
end;
Implementation Section
{┌────────────────────────────────────────────────────────────┐}
{│ MenuHints Implementation │}
{├────────────────────────────────────────────────────────────┤}
{│ Adapted from Zarko Gajic's article called │}
{│ How to Display Menu Item Hints in Delphi Applications │}
{│ http://delphi.about.com/od/vclusing/a/menuitemhints.htm │}
{│ │}
{│ Further adapted by mghie's stackoverflow answer to │}
{│ Display a ToolTip hint on a disabled menu item of a │}
{│ popup menu │}
{│ http://stackoverflow.com/questions/470696/#471065 │}
{│ │}
{│ Modified to accomodate multi line hints │}
{├────────────────────────────────────────────────────────────┤}
{│ Generic Section │}
{├────────────────────────────────────────────────────────────┘}
{│} procedure TMenuItemHint.HideTime(Sender: TObject);
{│} begin
{│} //hide (destroy) hint window
{│} self.ReleaseHandle;
{│} hideTimer.OnTimer := nil;
{│} end;
{├────────────────────────────────────────────────────────────┐}
{│ procedure: TMenuItemHint.ShowTime │}
{│ Modified: 12/27/2014 │}
{│ By: Michael Riley │}
{│ Reason: Accomodate multi line hints │}
{│ Changed the position and size of the TRect │}
{├────────────────────────────────────────────────────────────┘}
{│} 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;
{│} 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.OnTimer := nil;
{│} 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;
{├────────────────────────────────────────────────────────────┐}
{│ Form Specific Section │}
{├────────────────────────────────────────────────────────────┘}
{│} procedure TfrmMain.MenuHintOnCreate;
{│} var
{│} NewWndProc: TFarProc;
{│} begin
{│} miHint := TMenuItemHint.Create(self);
{│} NewWndProc := MakeObjectInstance(PopupListWndProc);
{│} fOldWndProc := TFarProc(SetWindowLong(VCL.Menus.PopupList.Window, GWL_WNDPROC, integer(NewWndProc)));
{│} end;
{├─────────────────────────────────────────────────────────────}
{│} procedure TfrmMain.MenuHintOnDestroy;
{│} var
{│} NewWndProc: TFarProc;
{│} begin
{│} NewWndProc := TFarProc(SetWindowLong(VCL.Menus.PopupList.Window, GWL_WNDPROC, integer(fOldWndProc)));
{│} FreeObjectInstance(NewWndProc);
{│} end;
{├─────────────────────────────────────────────────────────────}
{│} procedure TfrmMain.WMMenuSelect(var Msg: TWMMenuSelect);
{│} var
{│} menuItem : TMenuItem;
{│} hSubMenu : HMENU;
{│} begin
{│} inherited; // from TCustomForm
{│}
{│} menuItem := nil;
{│} if (Msg.MenuFlag <> $FFFF) or (Msg.IDItem <> 0) then
{│} begin
{│} if Msg.MenuFlag and MF_POPUP = MF_POPUP then
{│} begin
{│} hSubMenu := GetSubMenu(Msg.Menu, Msg.IDItem);
{│} menuItem := Self.Menu.FindItem(hSubMenu, fkHandle);
{│} end
{│} else
{│} begin
{│} menuItem := Self.Menu.FindItem(Msg.IDItem, fkCommand);
{│} end;
{│} end;
{│}
{│} miHint.DoActivateHint(menuItem);
{│} end; (*WMMenuSelect*)
{├─────────────────────────────────────────────────────────────}
{│} procedure TfrmMain.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.
