Delphi-任意气泡位置_delphi 气泡-优快云博客

本文链接：https://blog.youkuaiyun.com/yusheng628/article/details/6196580

本文介绍了一种在Delphi应用程序中实现自定义工具提示框的方法。通过创建一个特殊的工具提示窗口并使用特定的消息和参数对其进行配置，可以为按钮等控件显示包含图标和自定义文本的提示框。

摘要生成于 C知道，由 DeepSeek-R1 满血版支持，前往体验 >

unit Unit1; interface uses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs,commctrl, StdCtrls, Buttons; type TForm1 = class(TForm) Button1: TButton; Memo1: TMemo; Button2: TButton; Button3: TButton; BitBtn1: TBitBtn; ComboBox1: TComboBox; procedure BitBtn1Click(Sender: TObject); procedure FormActivate(Sender: TObject); private { Private declarations } public { Public declarations } 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); 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.BitBtn1Click(Sender: TObject); begin CreateBox(TButton(form1.FindComponent(Combobox1.Text)).Handle,'处理群内陌生人问题','你好'); end; procedure TForm1.FormActivate(Sender: TObject); var i:integer; begin for i:=0 to ComponentCount-1 do //得到窗体的所有控件。 Combobox1.Items.Add(Components[i].Name); Combobox1.ItemIndex:=0;//设置选中第一项。 end; end.

备注：如果用了XP样式，要把上面的Sleep(t)改成Delay(t)

效果图：