Delphi实现菜单项上出现提示
2007-05-21 12:10
375 查看
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;
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;
相关文章推荐
- Delphi实现菜单项上出现提示
- Delphi实现菜单项上出现提示
- 在delphi中实现密码框“大写锁定打开”的提示
- 用Delphi实现快闪窗体信息提示
- 这两天好郁闷,用了三年的Delphi居然出现这样的界面提示~
- 当发生异常时,怎样能不让‘delphi的异常提示框出现’而出现自己的‘异常提示框’?
- 实现用户在ListView上进行选择时出现向上或向下获取更多提示
- jquery实现鼠标移动出现提示信息
- 用ViewStub及SharePreferecesUtlils实现首次登录出现提示消息
- js 页面关闭前的出现提示的实现代码
- 在delphi中实现密码框“大写锁定打开”的提示
- asp.net mvc当出现错误时如何实现友好错误提示
- 在Delphi中实现的“汽车每跑6000公里(>=6000)换机油”的提示功能!
- jquery实现鼠标移动出现提示信息效果代码
- Yii2实现表单客户端验证提示信息出现在指定位置
- Delphi中用API实现在MSN的信息提示
- Javascript 实现鼠标移动到html元素出现提示框 转
- 最大堆---实现一个简化的搜索提示系统。给定一个包含了用户query的日志文件,对于输入的任意一个字符串s,输出以s为前缀的在日志中出现频率最高的前10条query。
- 百度输入提示 Delphi 实现