首页 > 代码库 > Delphi实现菜单项上出现提示

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..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实现菜单项上出现提示