type TMenuHintWindow = class(THintWindow) private FTimerShow: TTimer; FTimerHide: TTimer; procedure TimerShowTimer(Sender: TObject); procedure TimerHideTimer(Sender: TObject); procedure ApplicationHint(Sender: TObject); public constructor Create(AOwner: TComponent); override; destructor Destroy; override; end; constructor TMenuHintWindow.Create(AOwner: TComponent); begin inherited; FTimerShow := TTimer.Create(nil); FTimerShow.OnTimer := TimerShowTimer; FTimerShow.Interval := Application.HintPause; FTimerShow.Enabled := False; FTimerHide := TTimer.Create(nil); FTimerHide.OnTimer := TimerHideTimer; FTimerHide.Interval := Application.HintHidePause; FTimerHide.Enabled := False; Application.OnHint := ApplicationHint; end; destructor TMenuHintWindow.Destroy; begin if Assigned(FTimerShow) then FTimerShow.Free; if Assigned(FTimerHide) then FTimerHide.Free; inherited; end; procedure TMenuHintWindow.ApplicationHint(Sender: TObject); var vHandle: THandle; vClassName: array[0..255] of Char; begin TimerHideTimer(FTimerHide); if Application.Hint <> '' then begin vHandle := WindowFromPoint(Mouse.CursorPos); GetClassName(vHandle, vClassName, SizeOf(vClassName)); if not SameText('#32768', vClassName) and (HTMENU <> SendMessage(Handle, WM_NCHITTEST, 0, MakeLong(Mouse.CursorPos.X, Mouse.CursorPos.Y))) then Exit; FTimerShow.Enabled := True; FTimerHide.Enabled := True; end; end; procedure TMenuHintWindow.TimerHideTimer(Sender: TObject); begin ReleaseHandle; FTimerShow.Enabled := False; FTimerHide.Enabled := False; end; procedure TMenuHintWindow.TimerShowTimer(Sender: TObject); var vRect: TRect; begin if Application.Hint <> '' then begin vRect := CalcHintRect(MaxInt, Application.Hint, nil); OffsetRect(vRect, Mouse.CursorPos.X + 16, Mouse.CursorPos.Y + 16); ActivateHint(vRect, Application.Hint); end; TTimer(Sender).Enabled := False; end; procedure TForm1.FormCreate(Sender: TObject); begin TMenuHintWindow.Create(Self); end;