您现在的位置:首页 >> VCL >> VCL >> 内容

Delphi实现菜单项上出现提示

时间:2011/9/3 16:27:07 点击:

  核心提示:type TMenuHintWindow = class(THintWindow)privateFTimerShow: TTimer;FTimerHide: TTimer;procedure Time...
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;

作者:王集鹄 来源:转载
共有评论 1相关评论
发表我的评论
  • 大名:
  • 内容:
本类推荐
  • 没有
本类固顶
  • 没有
  • 盒子文章(www.2ccc.com) © 2017 版权所有 All Rights Reserved.
  • 沪ICP备05001939号