• 设为首页
  • 点击收藏
  • 手机版
    手机扫一扫访问
    迪恩网络手机版
  • 关注官方公众号
    微信扫一扫关注
    公众号

delphi气泡提示

原作者: [db:作者] 来自: [db:来源] 收藏 邀请

气泡提示比弹出框可能用户体验更好,下面是从网上搜索来的代码

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.

  


鲜花

握手

雷人

路过

鸡蛋
该文章已有0人参与评论

请发表评论

全部评论

专题导读
上一篇:
毕业论文A.1 Matlab环境配置 - Ethan.Wong发布时间:2022-07-18
下一篇:
****-三课时精通matlab常微分方程求解-Matlab发布时间:2022-07-18
热门推荐
阅读排行榜

扫描微信二维码

查看手机版网站

随时了解更新最新资讯

139-2527-9053

在线客服(服务时间 9:00~18:00)

在线QQ客服
地址:深圳市南山区西丽大学城创智工业园
电邮:jeky_zhao#qq.com
移动电话:139-2527-9053

Powered by 互联科技 X3.4© 2001-2213 极客世界.|Sitemap