弹出式气泡，使用winAPI

unit Ut_BalloonHint;
interface
uses
Windows, Messages,Graphics, SysUtils, StdCtrls,Commctrl;
const
TTS_BALLOON    = $40;
TTM_SETTITLE = (WM_USER + 32);
type
TBalloonHint = class(TObject)
    private
       hTooltip: Cardinal;      //气球窗口句柄
       hExternal : THandle;     //外部控件句柄（如按钮等）
       buffer : array[0..255] of char; //存放提示信息
       ti: TToolInfo;
       //BackColor,TextColor分别是背景颜色和文本颜色,如果是0则取默认值.
       procedure AddToolTip(hwnd: dword; lpti: PToolInfo; IconType: Integer; Text, Title: PChar; BackColor,TextColor:TColor);
    public
       constructor Create(hWnd: Cardinal);
       procedure ShowMsg(conType: Integer; msg,msgTitle: String; BackColor :TColor = 0; TextColor:TColor =0);
end;
implementation

//==============实现飞跃提示——包括提示的标题、内容、图标等项目========================
procedure TBalloonHint.AddToolTip(hwnd: dword; lpti: PToolInfo;
IconType: Integer; Text, Title: PChar; BackColor, TextColor: TColor);
var
Rect: TRect;
begin
if (hwnd <> 0) AND (GetClientRect(hwnd, Rect)) then
begin
   lpti.hwnd := hwnd;
   lpti.Rect := Rect;
   lpti.lpszText := Text;
   SendMessage(hToolTip, TTM_ADDTOOL, 0, Integer(lpti));
   FillChar(buffer, sizeof(buffer), #0);
   lstrcpy(buffer, Title);
   if (IconType > 3) or (IconType < 0) then IconType := 0;
   if BackColor<>0 then
    SendMessage(hToolTip, TTM_SETTIPBKCOLOR, BackColor, 0);
   if TextColor<>0 then
    SendMessage(hToolTip, TTM_SETTIPTEXTCOLOR, TextColor, 0);
   SendMessage(hToolTip, TTM_SETTITLE, IconType, Integer(@buffer));
end;
end;
//==============气泡构造函数========================
constructor TBalloonHint.Create(hWnd: Cardinal);
begin
   hExternal := hWnd;
   // CreateWindowEx 创建一个具有扩展风格的子窗口
   hToolTip := CreateWindowEx(0, 'Tooltips_Class32', nil, TTS_ALWAYSTIP or TTS_BALLOON,
   Integer(CW_USEDEFAULT), Integer(CW_USEDEFAULT),Integer(CW_USEDEFAULT),
   Integer(CW_USEDEFAULT), hWnd, 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_SUBCLASS or TTF_TRANSPARENT;
     ti.hInst := hInstance;
   end;
end;

//==============显示气泡提示========================
procedure TBalloonHint.ShowMsg(conType: Integer; msg,msgTitle: String; BackColor, TextColor: TColor);
begin
AddToolTip(hExternal, @ti, conType, PChar(Msg), PChar(msgTitle) ,BackColor,TextColor);
end;
end.

---------------------------------------------------------------------------------------------------------------------------------------

页面2 ：

unit test;

interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs,Ut_BalloonHint, StdCtrls;

type
TForm1 = class(TForm)
    Button1: TButton;
    Button2: TButton;
    Button3: TButton;
    Button4: TButton;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);
    procedure Button4Click(Sender: TObject);
private
    { Private declarations }
public
    { Public declarations }
end;

var
Form1: TForm1;

implementation

{$R *.dfm}

//==================无图标的飞跃提示==================
procedure TForm1.Button1Click(Sender: TObject);
var
   h :TBalloonHint;
begin
   h := TBalloonHint.Create(Button1.Handle);
   h.ShowMsg(0,'气泡提示','');
   h.Free;
end;

//==================蓝色信息提示图标的飞跃提示==================
procedure TForm1.Button2Click(Sender: TObject);
var
   h :TBalloonHint;
begin
   h := TBalloonHint.Create(Button2.Handle);
   h.ShowMsg(1,'气泡提示','信息图标');
   h.Free;
end;
//==================黄色警告图标的飞跃提示==================
procedure TForm1.Button3Click(Sender: TObject);
var
   h :TBalloonHint;
begin
   h := TBalloonHint.Create(Button3.Handle);
   h.ShowMsg(2,'气泡提示','警告图标');
   h.Free;
end;

//==================红色错误图标的飞跃提示==================
procedure TForm1.Button4Click(Sender: TObject);
var
   h :TBalloonHint;
begin
   h := TBalloonHint.Create(Button4.Handle);
   h.ShowMsg(3,'气泡提示','错误图标');
   h.Free;
end;

end.

弹出式气泡，使用winAPI相关推荐

Ajax弹出式无刷新城市选择特效
为什么80%的码农都做不了架构师?>>> <!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Transitional// ...
5弹出阴影遮罩_千文详述Cocos Creator弹出式对话框实现技术，着实硬核
正文在Cocos Creator游戏开发中,经常需要使用到弹出式对话框,下面我们就一起来封装下自己的弹出式对话框. 一.弹出式对话框原理解析 1:对话框的结构: 1. `根节点 -->`2. ...
自动弹窗被拦截 html,弹出式窗口被阻止怎么办,如何阻止弹出式窗口
很多人看到"弹出式窗口"这个名词时想必会有所疑惑,弹出与固定式窗口究竟有何不同呢?其实我们在浏览网页的时候就会发现许多弹出式窗口,这种窗口主要应用于广告类,许多商家会为各种大小网页 ...
弹出确定_Redmi K30 Pro再剧透：弹出式全面屏，没有高刷
近日,Redmi红米手机正式宣布了新机Redmi K30 Pro的发布计划,正在进行发布前的新机预热.今天Redmi红米手机再次公布了Redmi K30 Pro的紫色配色方案.与前两款配色一样,这款新 ...
2021年，戴尔的显示器竟然出现了弹出式摄像头
正文字数:1359 阅读时长:2分钟戴尔最新的显示器反映了市场上对简单.可靠的视频会议解决方案需求的不断增长,该显示器配有一个巧妙的弹出式摄像头. 作者 / Devin Coldewey 原文链接 ...
pyqt5子窗口跳出主窗口_弹出式窗口与可用性，转换和跳出率
pyqt5子窗口跳出主窗口 Written by Cassandra Naji 由卡珊德拉·纳吉 ( Cassandra Naji)撰写 They go by many names - modal w ...
javafx弹出式窗口_JavaFX 8的弹出式编辑器
javafx弹出式窗口在过去的几个月中,我很高兴与JavaFX 8一起使用,以便为计划和调度应用程序实现复杂的用户界面. 所需的功能之一是执行"就地"编辑的方法,即快速编辑用户选 ...
JavaFX 8的弹出式编辑器
在过去的几个月中,我很高兴与JavaFX 8一起使用,以便为计划和调度应用程序实现复杂的用户界面. 所需的功能之一是执行"就地"编辑的方法,即快速编辑用户选择对象的某些基本属性的方 ...
Operating System-Thread(5)弹出式线程使单线程代码多线程化会产生那些有关问题
Operating System-Thread(5)弹出式线程&&使单线程代码多线程化会产生那些问题本文主要内容弹出式线程(Pop-up threads) 使单线程代码多线程化会产 ...
ZH奶酪：Ionic中（弹出式窗口）的$ionicModal使用方法
Ionic中[弹出式窗口]有两种(如下图所示),$ionicModal和$ionicPopup; $ionicModal是完整的页面: $ionicPopup是(Dialog)对话框样式的,直接用Ja ...

弹出式气泡，使用winAPI

弹出式气泡，使用winAPI相关推荐

最新文章

热门文章