昨天的博客中介绍了,如何使用delphi的气泡提示,但是这种方式的提示,只有鼠标在一定范围内时才可以很好的显示,如果我们要在程序中应用,似乎这样的效果不会带来很大价值,下面介绍一种更好控制的方法,来实现制定位置的提示显示。
代码如下:
unit Unit1; interface uses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs,commctrl, StdCtrls, Buttons; type TForm1 = class(TForm) Button1: TButton; ListBox1: TListBox; Edit1: TEdit; cbb1: TComboBox; Label1: TLabel; procedure Button1Click(Sender: TObject); procedure FormActivate(Sender: TObject); end; var Form1: TForm1; implementation {$R *.dfm} procedure CreateBox(h: HWND; text, cap : string; IconType: Integer = 1; T: Integer = 1000); var r : TRect; hTooltip: Cardinal; ti: TToolInfo; begin hToolTip := CreateWindow('Tooltips_Class32',nil,$40,0,0,0,0,0,0,hInstance,nil); if hToolTip <> 0 then begin SetWindowPos(hToolTip, HWND_TOPMOST,0,0,0,0,SWP_NOMOVE or SWP_NOSIZE or SWP_NOACTIVATE); //让气泡在最前面 ti.cbSize := SizeOf(TToolInfo); ti.uFlags := TTF_IDISHWND or TTF_TRACK; ti.hInst := hInstance; ti.lpszText :=pchar(text); SendMessage(hToolTip, TTM_ADDTOOL, 0, Integer(@ti)); if (IconType > 3) or (IconType < 0) then IconType:=0; SendMessage(hToolTip,WM_USER + 32,IconType,Integer(pchar(cap))); GetWindowRect(H,R); //获取指定控件的坐标,R.Right 、R.Left、R.Bottom、R.Top SendMessage(hToolTip,TTM_TRACKPOSITION, 0, MAKELONG((r.Right - r.Left) div 2 + r.Left, (r.Bottom - r.Top) div 2 + r.Top)); // 定义气泡位置 SendMessage(hToolTip, TTM_TRACKACTIVATE, Integer(True), Integer(@ti)); Sleep(t); DestroyWindow(hToolTip); end; end; procedure TForm1.Button1Click(Sender: TObject); begin CreateBox(TButton(form1.FindComponent(cbb1.Text)).Handle,'控件' + cbb1.Text,'你好'); end; procedure TForm1.FormActivate(Sender: TObject); var i:integer; begin for i := 0 to ComponentCount - 1 do cbb1.Items.Add(Components[i].Name); cbb1.ItemIndex:=0; end; end.
这样就可以实现指定位置的气泡提示显示,当我们需要给出提示时,便可以这样来操作。
由于今天上传图片一直有问题,所以没有相应的图片,还需要大家自己编译一下,和昨天的效果进行对比