大悟还俗

邮箱 key_ok@qq.com 我的收集 http://pan.baidu.com/share/home?uk=1177427271
  新随笔  :: 联系 :: 订阅 订阅  :: 管理

Delphi实现菜单项上出现提示

Posted on 2013-10-09 17:36  大悟还俗_2  阅读(279)  评论(0编辑  收藏  举报
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