I got the code below from the website ThoughtCo. (Zarko Gajic) - it presents the hint near the mouse pointer when it is in the menu item:
However, it has a bug: when the menu is opened by the keyboard the tooltip appears next to the mouse pointer, regardless of the location on the screen where the mouse pointer is:
I tried to fix the bug by adding the lines that are commented. Now the error is that the hint always appears regardless of whether you click the menu item quickly or not.
How to fix this problem?
procedure TfrmPrincipal.WMMenuSelect(var Msg: TWMMenuSelect);
var
menuItem : TMenuItem;
hSubMenu : HMENU;
hPopupWnd: HWND; // Added
R: TRect; // Added
Pt: TPoint; // Added
begin
inherited;
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;
hPopupWnd := FindWindow('#32768', nil); // Added
if hPopupWnd = 0 then Exit; // Added
GetWindowRect(hPopupWnd, R); // Added
GetCursorPos(Pt); // Added
if PtInRect(R, Pt) then // Added
miHint.DoActivateHint(menuItem)
else // Added
miHint.DoActivateHint(nil); // Added
end;
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
hideTime(self);
if (menuItem = nil) or (menuItem.Hint = '') then
begin
activeMenuItem := nil;
Exit;
end;
activeMenuItem := menuItem;
showTimer.OnTimer := ShowTime;
hideTimer.OnTimer := HideTime;
end;
procedure TMenuItemHint.HideTime(Sender: TObject);
begin
self.ReleaseHandle;
hideTimer.OnTimer := nil;
end;
procedure TMenuItemHint.ShowTime(Sender: TObject);
var
r : TRect;
wdth : integer;
hght : integer;
begin
if activeMenuItem <> nil then
begin
wdth := Canvas.TextWidth(activeMenuItem.Hint);
hght := Canvas.TextHeight(activeMenuItem.Hint);
r.Left := Mouse.CursorPos.X + 16;
r.Top := Mouse.CursorPos.Y + 16;
r.Right := r.Left + wdth + 6;
r.Bottom := r.Top + hght + 4;
ActivateHint(r,activeMenuItem.Hint);
end;
showTimer.OnTimer := nil;
end;
WM_MENUSELECT
tells you whether the menu item is being selected by mouse or keyboard.
If the MF_MOUSESELECT
flag is present, use the mouse coordinates provided by GetCursorPos()
(or the VCL's TMouse.CursorPos
wrapper), or GetMessagePos()
.
If the flag is not present, use GetMenuItemRect()
to get the screen coordinates of the bounding rectangle of the specified menu item, and then use whatever coordinates you want that are within that rectangle (centered, bottom edge, etc).
You should NOT be trying to work with the menu window directly at all, so get rid of your calls to FindWindow()
, GetWindowRect()
, and PtInRect()
.