delphimenuhint

Delphi: Menu Hint bug


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:

Submenu opened with hovering mouse cursor, showing item's hint

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:

Submenu opened, mouse cursor outside menu item, still showing item's hint

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;

Solution

  • 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().