Delphi 之弹出气泡消息提示
//h:窗体中控件的句柄(用在某个控件上提示消息)(要调用的控件句柄) //text:要提示的文本 //cap:提示框上的标题 //IconType:提示框上显示的图标(共三个值。1、2、3分别为提示、警告、错误s) //t:消息停留的时间(以毫秒计算) //left: 消息框偏离控件的左距离,设为0则表示没有 //top: 消息框偏离控件的顶距离,设为0则表示没有
procedure TFrmMain.QiPaoShowMessage(h:HWND;text,cap:string;IconType:integer=;t:integer=;left:Integer=;top:Integer=);
var
r : TRect; //是一个记录(Record),保存了矩形的(左上角右下角两个点)4个坐标或2个点的值。
hTooltip: Cardinal; //Cardinal是无符号32位整数 ,取值0到4294967295范围。
ti: TToolInfo;
begin
hToolTip := CreateWindow('Tooltips_Class32',nil,$,,,,,,,hInstance,nil);
if hToolTip <> then
begin
SetWindowPos(hToolTip, HWND_TOPMOST,,,,,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, , Integer(@ti));
if (IconType > ) or (IconType < ) then IconType:=;
SendMessage(hToolTip,WM_USER + ,IconType,Integer(pchar(cap)));
GetWindowRect(H,R); //获取指定控件的坐标,R.Right 、R.Left、R.Bottom、R.Top
r.Left:=r.Left-left;
r.Top:=r.Top-top; // 定义气泡位置
SendMessage(hToolTip,TTM_TRACKPOSITION, , MAKELONG((r.Right - r.Left) div + r.Left, (r.Bottom - r.Top) div + r.Top)); SendMessage(hToolTip, TTM_TRACKACTIVATE, Integer(True), Integer(@ti));
Sleep(t);
DestroyWindow(hToolTip);
end;
end;
///////////////////////----------参数说明---------------------//////////////////////
//h:窗体中控件的句柄(用在某个控件上提示消息)(要调用的控件句柄)
//text:要提示的文本
//cap:提示框上的标题
//IconType:提示框上显示的图标(共三个值。1、2、3分别为提示、警告、错误s)
//t:消息停留的时间(以毫秒计算)
//left: 消息框偏离控件的左距离,设为0则表示没有
//top: 消息框偏离控件的顶距离,设为0则表示没有
procedure TFrmMain.QiPaoShowMessage(h:HWND;text,cap:string;IconType:integer=1;t:integer=1000;left:Integer=0;top:Integer=0);
var
r : TRect; //是一个记录(Record),保存了矩形的(左上角右下角两个点)4个坐标或2个点的值。
hTooltip: Cardinal; //Cardinal是无符号32位整数 ,取值0到4294967295范围。
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
r.Left:=r.Left-left;
r.Top:=r.Top-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;
结果如下所示:

Delphi 之弹出气泡消息提示的更多相关文章
- JS组件系列——Bootstrap寒冬暖身篇:弹出框和提示框效果以及代码展示
前言:对于Web开发人员,弹出框和提示框的使用肯定不会陌生,比如常见的表格新增和编辑功能,一般常见的主要有两种处理方式:行内编辑和弹出框编辑.在增加用户体验方面,弹出框和提示框起着重要的作用,如果你的 ...
- Bootstrap:弹出框和提示框效果以及代码展示
前言:对于Web开发人员,弹出框和提示框的使用肯定不会陌生,比如常见的表格新增和编辑功能,一般常见的主要有两种处理方式:行内编辑和弹出框编辑.在增加用户体验方面,弹出框和提示框起着重要的作用,如果你的 ...
- JS组件Bootstrap实现弹出框和提示框效果代码
这篇文章主要介绍了JS组件Bootstrap实现弹出框和提示框效果代码,对弹出框和提示框感兴趣的小伙伴们可以参考一下 前言:对于Web开发人员,弹出框和提示框的使用肯定不会陌生,比如常见的表格新增和编 ...
- Bootstrap篇:弹出框和提示框效果以及代码展示
前言:对于Web开发人员,弹出框和提示框的使用肯定不会陌生,比如常见的表格新增和编辑功能,一般常见的主要有两种处理方式:行内编辑和弹出框编辑.在增加用户体验方面,弹出框和提示框起着重要的作用,如果你 ...
- Swift之高德地图自定义标注弹出气泡样式
在用到地图类的sdk,sdk自带的样式必定不能满足开发者的需求,于是开发者不得不进行自定义,由于官方同样是object-c 版语法,不得不将其转为swift语法,以满足项目需求. 新建两个类 Cust ...
- 用MPLAB IDE编程时,软件总是弹出一个窗口提示: “the extended cpu mode configuration bit is enabled,but the program that was loaded was not built using extended cpu instructions. therefore,your code may not work properly
用MPLAB IDE编程时,软件总是弹出一个窗口提示:"the extended cpu mode configuration bit is enabled,but the program ...
- Jquery hover鼠标经过时弹出div动态提示语
一.效果图 二.需求描述 1.鼠标经过table每一行时,弹出div动态提示语: 2.div弹出层的位置随鼠标位置的变化而变化: 3.鼠标离开table或获取的动态提示语为空时,div弹出层消失. 下 ...
- Bootstrap实现弹出框和提示框效果代码
一.Bootstrap弹出框使用过JQuery UI应该知道,它里面有一个dialog的弹出框组件,功能也很丰富.与jQuery UI的dialog类似,Bootstrap里面也内置了弹出框组件.打开 ...
- VS2010添加类失败问题,弹出错误框,提示 CodeModel操作失败,无法访问标记数据库
我在使用VS2010添加类的时候,会弹出一个错误框,提示 CodeModel操作失败,可以无法访问标记数据库 英文版是 CodeModel operation failed,Possibly cann ...
随机推荐
- python全栈开发day57- pymysql、视图、触发器、函数
一.昨日内容回顾 1.单表查询 优先级 from where group by having select distinct order by limit 2 . 多表查询 inner join... ...
- Codeforces 1132E (看题解)
感觉这个题挺有意思的, 我们可以将 L = lcm(1, 2, 3, ... , 8) 看作一组. 然后用dp[ i ][ j ]表示到第 i 种物品当前的值为 j 能用L的最大数量. #includ ...
- day29 网络编程
网络通信原理: http://www.cnblogs.com/linhaifeng/articles/5937962.html 一.操作系统基础 二.网络通信原理 2.1 互联网的本质就是一系列的网络 ...
- union排序,起别名将两个不同的字段ZCDZ,SCJYDZ 变成同一个别名dz,进行排序;增加一个字段z,进行排序。
with a as( select NSRSBH,NSRMC,ZGSWJ_DM,ZGSWSKFJ_DM,SSGLY_DM,FDDBRXM,ZCDZ dz,1 z from hx_dj.dj_nsrxx ...
- [dotnet core]使用Peach简化Socket网络通讯协议开发
Peach是基于DotNetty的Socket网络通讯帮助类库,可以帮助开发者简化使用DotNetty,关于DotNetty可参考我之前的这篇文章. Peach内置实现了一个基于文本协议的Comman ...
- AngularJS之拖拽排序(ngDraggable.js)
ngDraggable.js是一款比较简单实用的angularJS拖拽插件,借助于封装好的一些自定义指令,能够快速的进行一些拖拽应用开发.首先先介绍一些基本的概念; ng-drop:是否允许放入拖拽元 ...
- Django项目中使用Redis
Django项目中使用Redis DjangoRedis 1 redis Redis 是一个 key-value 存储系统,常用于缓存的存储.django-redis 基于 BSD 许可, 是一个使 ...
- python网站开发准备ubuntu14.04安装mysql实现windows管理
sudo apt-get install mysql-server mysql-client 输入root密码 然后确认安装tab选定确认 输入数据库密码 重复输入 启动 sudo service m ...
- sudo passwd root输入普通用户密码后显示用户不再sudoers文件中
在写上一篇VirtualBox创建共享文件夹的时候,在运行下图授权时,root密码一直输入错误 然后我就在终端输入 su root,却发现需要密码,但我却不知道密码是什么 于是我就在终端输入如下命令, ...
- C# 动态调用WebService 2
using Microsoft.CSharp; using System; using System.CodeDom; using System.CodeDom.Compiler; using Sys ...