Delphi实现菜单项上出现提示

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;

View Code