Программирование Delphi

Когда мышь находится над компонентом (например TButton), а свойство ShowHint равно True и есть какой-то текст в свойстве Hint этого компонента, то появляется окошко подсказки для этого компонента.

Но из-за особенностей Windows, даже если Вы установите свойство Hint для меню, подсказка появляться не будет. Но можно использовать событие OnHint объекта Application для отображения подсказки в строке состояния.

Когда пользователь выбирает пункт меню, отправляется сообщение WM_MENUSELECT. Если Вы хотите добавить подсказку в пункт меню, нужно просто соответствующим образом обработать сообщение WM_MENUSELECT.

Поскольку Вы не можете полностью полагаться на метод Application.ActivateHint для отображения подсказки в пунктах меню (работа меню полностью происходит в Windows), чтобы получить подсказку, нужно создать свою собственную версию окна подсказки путем выведения нового класса от THintWindow.

Итак, класс TMenuItemHint, потомок от THintWindow:

unit HintClass;

interface

uses
  Windows, Controls, Menus, ExtCtrls, Classes, Forms;

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;
    procedure DoActivateHint(menuItem: TMenuItem);
    destructor Destroy; override;
  end;

implementation

{ TMenuItemHint }

constructor TMenuItemHint.Create(AOwner: TComponent);
begin
  inherited;

  showTimer:= TTimer.Create(Self);
  showTimer.Interval:= Application.HintPause;

  hideTimer:= TTimer.Create(Self);
  hideTimer.Interval:= Application.HintHidePause;
end; { *Create* }

destructor TMenuItemHint.Destroy;
begin
  hideTimer.OnTimer:= nil;
  showTimer.OnTimer:= nil;
  Self.ReleaseHandle;
  inherited;
end; { *Destroy* }

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; { *DoActivateHint* }

procedure TMenuItemHint.HideTime(Sender: TObject);
begin
  { Скрываем (удаляем) окно подсказки}
  Self.ReleaseHandle;
  hideTimer.OnTimer:= nil;
end; { *HideTime* }

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;

end.

И само приложение, на форме которого находится TMainMenu, TApplicationEvents (для вывода подсказки в строку состояния), TStatusBar просто для наглядности.

Здесь мы обрабатываем сообщение WM_MENUSELECT, чтобы определиться с пунктом меню.

Ниже приводится полный текст кода формы приложения.

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, Menus, HintClass, AppEvnts, ComCtrls;

type
  TForm1 = class(TForm)
    MainMenu1: TMainMenu;
    mnuFile: TMenuItem;
    mnuOpen: TMenuItem;
    mnuSave: TMenuItem;
    N4: TMenuItem;
    mnuExit: TMenuItem;
    StatusBar1: TStatusBar;
    ApplicationEvents1: TApplicationEvents;
    N1: TMenuItem;
    N11: TMenuItem;
    imagejpg1: TMenuItem;
    PopupMenu1: TPopupMenu;
    N2: TMenuItem;
    N3: TMenuItem;
    N5: TMenuItem;
    N6: TMenuItem;
    procedure ApplicationEvents1Hint(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure mnuExitClick(Sender: TObject);
  private
    { Private declarations }
    myHint: TMenuItemHint;
    procedure WMMenuSelect(var Msg: TWMMenuSelect); message WM_MENUSELECT;
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.ApplicationEvents1Hint(Sender: TObject);
begin
  { Выводим подсказку в панель состояния }
  StatusBar1.SimpleText:= Application.Hint;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  myHint:= TMenuItemHint.Create(Self);
end;

procedure TForm1.mnuExitClick(Sender: TObject);
begin
  Close;
end;

procedure TForm1.WMMenuSelect(var Msg: TWMMenuSelect);
var
  menuItem: TMenuItem;
  hSubMenu: HMENU;
begin
  inherited; // из 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;

  myHint.DoActivateHint(menuItem);
end;

end.

Можно скачать исходный код программы.