unit SherryHint;
interface
uses
Windows, Messages, Classes, Controls, Forms, CommCtrl;
type
THintWin=class(THintWindow)
private
FLastActive: THandle;
public
procedure ActivateHint(Rect:TRect;Const AHint:string);override;
end;
implementation
procedure AddTipTool(hWnd: DWORD; IconType: Integer; Title, Text: PChar);
const
TTS_BALLOON =$0040;
TTM_SETTITLE=WM_USER + 32;
var
hWndTip: DWORD;
ToolInfo: TToolInfo;
begin
hWndTip:=CreateWindow(TOOLTIPS_CLASS, nil,
WS_POPUP or TTS_NOPREFIX or TTS_BALLOON or TTS_ALWAYSTIP,
0, 0, 0, 0, hWnd, 0, HInstance, nil);
if (hWndTip<>0) then
begin
ToolInfo.cbSize:=SizeOf(ToolInfo);
ToolInfo.uFlags:=TTF_IDISHWND or TTF_SUBCLASS or TTF_TRANSPARENT;
ToolInfo.uId:=hWnd;
ToolInfo.lpszText:=Text;
SendMessage(hWndTip,TTM_ADDTOOL,1,Integer(@ToolInfo));
SendMessage(hWndTip,TTM_SETTITLE,IconType,Integer(Title));
end;
InitCommonControls();
end;
procedure THintWin.ActivateHint(Rect:TRect;const AHint:string);
begin
if FLastActive<>WindowFromPoint(Mouse.CursorPos) then
AddTipTool(WindowFromPoint(Mouse.CursorPos),0,'说明:', PChar(AHint));//Application.Hint));
FLastActive:=WindowFromPoint(Mouse.CursorPos);
end;
initialization
Application.HintPause:=0;
Application.ShowHint:=False;
HintWindowClass:=THintWin;
Application.ShowHint:=True;
end.
在use 添加SherryHint 以前的按钮 等hit 提示就变成气泡型了
但是我发现有个bug， 就是比如勾选框那 我改变了Hit 字提示， 放鼠标上去还是之前的文字提示要等几秒或者久一点才刷新 新的hit 提示
有没有大神帮弄一下 修复这个算bug吗。。。
或者有其他好的办法 改变Hit 提示吗。。 网上找了很多，这种类似的，但都存在这个bug，。。要是完美一点就好了。。
