任何在TDBEdit控件上显示气泡提示?(20分)

  • 主题发起人 主题发起人 ADSL07
  • 开始时间 开始时间
A

ADSL07

Unregistered / Unconfirmed
GUEST, unregistred user!
任何在TDBEdit控件上显示气泡提示?<br>像在XP登录时一样,有三角形的气泡提示信息。<br>Delphi怎么用它?<br>在线等。
 
气泡提示控件不可少<br>THintManager
 
从哪里下载?<br>我在线等。
 
unit Unit1;<br><br>interface<br><br>uses<br> &nbsp;Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,<br> &nbsp;Dialogs, commctrl, StdCtrls;<br><br>const<br> &nbsp;TTS_BALLOON = $40;<br> &nbsp;TTM_SETTITLE = (WM_USER + 32);<br><br>type<br> &nbsp;TForm1 = class(TForm)<br> &nbsp; &nbsp;Button1: TButton;<br> &nbsp; &nbsp;Memo1: TMemo;<br> &nbsp; &nbsp;Button2: TButton;<br> &nbsp; &nbsp;Button3: TButton;<br> &nbsp; &nbsp;Button4: TButton;<br> &nbsp; &nbsp;procedure Button1Click(Sender: TObject);<br> &nbsp; &nbsp;procedure Button2Click(Sender: TObject);<br> &nbsp; &nbsp;procedure Button3Click(Sender: TObject);<br> &nbsp; &nbsp;procedure Button4Click(Sender: TObject);<br> &nbsp;private<br> &nbsp; &nbsp;{ Private declarations }<br> &nbsp;public<br> &nbsp; &nbsp;{ Public declarations }<br> &nbsp;end;<br><br> &nbsp;procedure AddToolTip(hwnd: DWORD; lpti: PToolInfo; IconType: Integer;<br> &nbsp; &nbsp;Text, Title: PChar);<br> &nbsp;procedure CreateToolTips(hwnd: Cardinal);<br><br>var<br> &nbsp;Form1: TForm1;<br> &nbsp;hTooltip: Cardinal;<br> &nbsp;ti: TToolInfo;<br> &nbsp;buffer: array[0..255] of char;<br><br>implementation<br><br>{$R *.dfm}<br><br>procedure CreateToolTips(hwnd: Cardinal);<br>begin<br> &nbsp;hTooltip := CreateWindowEx(0, 'Tooltips_Class32', nil,<br> &nbsp; &nbsp;TTS_ALWAYSTIP or TTS_BALLOON,<br> &nbsp; &nbsp;Integer(CW_USEDEFAULT),<br> &nbsp; &nbsp;Integer(CW_USEDEFAULT),<br> &nbsp; &nbsp;Integer(CW_USEDEFAULT),<br> &nbsp; &nbsp;Integer(CW_USEDEFAULT),<br> &nbsp; &nbsp;hwnd, 0, hInstance, nil);<br> &nbsp;if hTooltip &lt;&gt; 0 then<br> &nbsp;begin<br> &nbsp; &nbsp;SetWindowPos(hTooltip, HWND_TOPMOST, 0, 0, 0, 0,<br> &nbsp; &nbsp; &nbsp;SWP_NOMOVE or SWP_NOSIZE or SWP_NOACTIVATE);<br> &nbsp; &nbsp;ti.cbSize := SizeOf(TToolInfo);<br> &nbsp; &nbsp;ti.uFlags := TTF_SUBCLASS;<br> &nbsp; &nbsp;ti.hInst := hInstance;<br> &nbsp;end;<br>end;<br><br>procedure AddToolTip(hwnd: DWORD; lpti: PToolInfo; IconType: Integer; Text, Title: PChar);<br>var<br> &nbsp;Item: THandle;<br> &nbsp;Rect: TRect;<br>begin<br> &nbsp;Item := hwnd;<br> &nbsp;if (Item &lt;&gt; 0) and (GetClientRect(Item, Rect)) then<br> &nbsp;begin<br> &nbsp; &nbsp;lpti.hwnd := Item;<br> &nbsp; &nbsp;lpti.Rect := Rect;<br> &nbsp; &nbsp;lpti.lpszText := Text;<br> &nbsp; &nbsp;SendMessage(hTooltip, TTM_ADDTOOL, 0, Integer(lpti));<br> &nbsp; &nbsp;FillChar(buffer, SizeOf(buffer), #0);<br> &nbsp; &nbsp;lstrcpy(buffer, Title);<br> &nbsp; &nbsp;if (IconType &gt; 3) or (IconType &lt; 0) then IconType := 0;<br> &nbsp; &nbsp;SendMessage(hTooltip, TTM_SETTITLE, IconType, Integer(@buffer));<br> &nbsp;end;<br>end;<br><br>procedure TForm1.Button1Click(Sender: TObject);<br>begin<br> &nbsp;CreateToolTips(Form1.Handle);<br> &nbsp;AddToolTip(Memo1.Handle, @ti, 0, '测试飞跃提示', '无图标提示');<br>end;<br><br>procedure TForm1.Button2Click(Sender: TObject);<br>begin<br> &nbsp;CreateToolTips(Form1.Handle);<br> &nbsp;AddToolTip(Memo1.Handle, @ti, 1, '测试飞跃提示', '信息图标');<br>end;<br><br>procedure TForm1.Button3Click(Sender: TObject);<br>begin<br> &nbsp;CreateToolTips(Form1.Handle);<br> &nbsp;AddToolTip(Memo1.Handle, @ti, 2, '测试飞跃提示', '警告图标');<br>end;<br><br>procedure TForm1.Button4Click(Sender: TObject);<br>begin<br> &nbsp;CreateToolTips(Form1.Handle);<br> &nbsp;AddToolTip(Memo1.Handle, @ti, 3, '测试飞跃提示', '错误图标');<br>end;<br><br>end.
 
接受答案了.
 

Similar threads

S
回复
0
查看
3K
SUNSTONE的Delphi笔记
S
S
回复
0
查看
2K
SUNSTONE的Delphi笔记
S
D
回复
0
查看
2K
DelphiTeacher的专栏
D
D
回复
0
查看
2K
DelphiTeacher的专栏
D
D
回复
0
查看
1K
DelphiTeacher的专栏
D
后退
顶部