码迷,mamicode.com
首页 > Windows程序 > 详细

Delphi实现菜单项上出现提示

时间:2017-01-24 22:54:09      阅读:257      评论:0      收藏:0      [点我收藏+]

标签:handle   lease   orm   ext   pos   long   component   sizeof   http   

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..255of 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;

http://blog.csdn.net/zswang/article/details/1619084

Delphi实现菜单项上出现提示

标签:handle   lease   orm   ext   pos   long   component   sizeof   http   

原文地址:http://www.cnblogs.com/findumars/p/6347928.html

(0)
(0)
   
举报
评论 一句话评论(0
登录后才能评论!
© 2014 mamicode.com 版权所有  联系我们:gaon5@hotmail.com
迷上了代码!