在线时间:8:00-16:00
迪恩网络APP
随时随地掌握行业动态
扫描二维码
关注迪恩网络微信公众号
气泡提示比弹出框可能用户体验更好,下面是从网上搜索来的代码 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.
|
2023-10-27
2022-08-15
2022-08-17
2022-09-23
2022-08-13
请发表评论