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;