【问题标题】:Delphi Menu Hint BugDelphi 菜单提示错误
【发布时间】:2018-07-08 15:42:41
【问题描述】:

我从网站“https://www.thoughtco.com”(Zarko Gajic)获得了以下代码。当它在菜单项中时,它会在鼠标指针附近显示提示。

但是,它有一个错误。当通过键盘打开菜单时,工具提示会出现在鼠标指针旁边,而不管鼠标指针在屏幕上的位置。

我试图通过添加被注释掉的行来修复这个错误。现在的错误是无论您是否快速单击菜单项,提示总是出现。

如何解决这个问题?

谢谢。

代码:

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;

【问题讨论】:

    标签: delphi menu hint


    【解决方案1】:

    WM_MENUSELECT 告诉您菜单项是通过鼠标还是键盘选择的。

    如果存在MF_MOUSESELECT 标志,请使用GetCursorPos()(或VCL 的TMouse.CursorPos 包装器)或GetMessagePos() 提供的鼠标坐标。

    如果标志不存在,请使用GetMenuItemRect() 获取指定菜单项的边界矩形的屏幕坐标,然后使用该矩形内的任何坐标(居中、底部边缘等)。

    您根本不应该尝试直接使用菜单窗口,所以不要再调用FindWindow()GetWindowRect()PtInRect()

    【讨论】:

    • 好的,雷米。我会尝试修复它。非常感谢您的回答。
    • 雷米...我做到了。正如你所说,我从代码中删除了注释行,并在“miHint.DoActivateHint(menuItem)”行之前添加了“if Msg.MenuFlag and MF_MOUSESELECT = MF_MOUSESELECT then”行,它可以工作!再次感谢。
    猜你喜欢
    • 1970-01-01
    • 2012-10-02
    • 2013-02-21
    • 2010-09-21
    • 1970-01-01
    • 1970-01-01
    • 2015-10-21
    • 1970-01-01
    • 1970-01-01
    相关资源
    最近更新 更多