再次推出精品 [卡通式气泡提示] 提供下载,美化程序必不可少. 看者有分 ( 积分: 100 )

０３年甚至之前就出现解决了,问题提交前 就没有查离线包 习惯，晕。。。

贴子见：http://www.delphibbs.com/delphibbs/dispq.asp?lid=1618481

procedure ShowBalloonTip(Control: TWinControl; Icon: integer; Title: pchar; Text: PWideChar);
//ShowBalloonTip(Button1, 1, 'Balloon Tooltip', 'Welcome http://dingbaosheng.delphibbs.com');
const
TOOLTIPS_CLASS = 'tooltips_class32';
TTS_ALWAYSTIP = $01;
TTS_NOPREFIX = $02;
TTS_BALLOON = $40;
TTF_SUBCLASS = $0010;
TTF_TRANSPARENT = $0100;
TTF_CENTERTIP = $0002;
TTM_ADDTOOL = $0400 + 50;
TTM_SETTITLE = (WM_USER + 32);
ICC_WIN95_CLASSES = $000000FF;
type
TOOLINFO = packed record
cbSize: integer;
uFlags: integer;
hwnd: THandle;
uId: integer;
rect: TRect;
hinst: THandle;
lpszText: PWideChar;
lParam: integer;
end;
var
hWndTip: THandle;
ti: TOOLINFO;
hWnd: THandle;
begin
hWnd := Control.Handle;
hWndTip := CreateWindow(TOOLTIPS_CLASS, nil,
WS_POPUP or TTS_NOPREFIX or TTS_BALLOON or TTS_ALWAYSTIP,
0, 0, 0, 0, hWnd, 0, HInstance, nil);
if hWndTip <> 0 then
begin
SetWindowPos(hWndTip, HWND_TOPMOST, 0, 0, 0, 0,
SWP_NOACTIVATE or SWP_NOMOVE or SWP_NOSIZE);
ti.cbSize := SizeOf(ti);
ti.uFlags := TTF_CENTERTIP or TTF_TRANSPARENT or TTF_SUBCLASS;
ti.hwnd := hWnd;
ti.lpszText := Text;
Windows.GetClientRect(hWnd, ti.rect);
SendMessage(hWndTip, TTM_ADDTOOL, 1, integer(@ti));
SendMessage(hWndTip, TTM_SETTITLE, Icon mod 4, Integer(Title));
end;
end;

TOupyt
D6,D7现在调用dll会出错,正在解决中,
现在测试环境是Delphi2006.
并且发现一个问题,以下:
Delphi2006制作DLL,在D7调用出错,反过来一样.(前提含有pchar,tcolor等类型)

TO:dingbaosheng
没看清楚问题,发言欠礼貌,你下载看看,就知道为什么不一样了.

jey兄,帮我编译一个D6的DLL看看
谢谢 我的邮箱upyt@163.com

TOupyt
没问题了,现在的DLL,
支持VC6.0
支持Delphi7
D6应该没问题了.之前出错,是由于控件类不对.

调用如下:
//控件句柄,标题,显示内容,图标,持续时间(毫秒)
procedure ShowTip(ControlHandle:THandle; Title: PChar; Msg: PChar; IconType: Integer=0; TimeoutSecs: Integer=1000 );stdcall; external 'ShowHint.dll';
procedure HideTip(ControlHandle:THandle);stdcall;external 'ShowHint.dll';
//背景颜色,字体颜色,持续类型(2对控件hint美化,不显示;1持续显示;0正常),显示类型
procedure SetTip(BackCl, TextCl:TColor;Duration:Smallint=0;Position:Smallint=0) stdcall;external 'ShowHint.dll';
新增加功能与去掉BUG
1,可以对每个控件,重新设置hint,只要设置Duration=2.
2,V++,VC,D7,D2006,VB都可以调动
3,一次显示多个气泡提示.
4,可以一直显示气泡,直至调用过程 HideTip(控件句柄).

发现有BUG朋友,及时告诉我.谢谢.

TO:dingbaosheng
你都是2000注册老富翁了,希望可以交流一下.
有意请加QQ:344430663

走自已的技术路线这很好

To:jey
>>没看清楚问题
冲你这句话 我下了你的DEMO 运行看过了效果
经比较 和我上面贴出来滴代码效果是差不多的
至于原因 你看我贴出来的代码就知道 不多说了
这个泡泡 其实中系统带的功能 我上面代码只是
演示信息光泡 你的DLL更细化了参数罢了。。。

BTW： BBS上老猫也写过相关文章。。。

创建漫画式飞跃提示
文 王甲春


飞跃提示（Hint）是什么？就是当鼠标停留在某一目标上时就会出现一条小小的提示信息，它主要用于提示用户该目标的相关信息。作为一款成熟的软件，必然会在程序界面里面设置很多的飞跃提示。图1所示就是鼠标放在按钮控件位置时Delphi本身的飞跃提示，和大部分常见的飞跃提示一样，它是方方正正的。
漫画式飞跃提示又叫气泡式飞跃提示，它以活泼的气泡式提示赢得了很多用户的喜欢，网上也出现了很多Delphi的VCL控件专门用户制作这样的Hint，其实我们自己编程实现起来也很容易，根本没有必要安装个第三方的控件。
首先我们定义好程序中使用的几个常量和变量，关于它们的功能在下面具体代码中有所说明。
const
TTS_BALLOON = $40;
TTM_SETTITLE = (WM_USER + 32);
var
hTooltip: Cardinal;
ti: TToolInfo;
buffer : array[0..255] of char;
我们要使用API函数CreateWindowEx创建一个具有扩展风格的子窗口作为飞跃提示用，然后用SetWindowPos函数设置该子窗口的位置和大小。有关API函数CreateWindowEx和SetWindowPos的详细参数与功能说明请查阅MSDN或其他API书籍，本文就不再详述。这样我们可以定义如下的过程创建飞跃提示窗口（hToolTip）：
procedure CreateToolTips(hWnd: Cardinal);
begin
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;
ti.hInst := hInstance;
end;
end;
注意CreateToolTips过程的hWnd参数就是你设计程序窗体的句柄。为了调用方便起见，下面再定义一个过程AddToolTip用于实现飞跃提示——包括提示的标题、内容、图标等项目。
procedure AddToolTip(hwnd: DWORD; lpti: PToolInfo; IconType: Integer;Text, Title: PChar);
var
Item: THandle;
Rect: TRect;
begin
Item := hWnd;
if (Item <> 0) and (GetClientRect(Item, Rect)) then
begin
lpti.hwnd := Item;
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;
SendMessage(hToolTip, TTM_SETTITLE, IconType, Integer(@buffer));
end;
end;
注意上面的AddToolTip过程，第一个参数hwnd是指需要实现漫画式飞跃提示的对象句柄，第二个参数是由CreateToolTips过程传递过来的指针，IconType参数是指飞跃提示的图标。
准备工作就绪以后，进一步在程序中实现漫画式飞跃提示的过程就变得很简单了。
图2所示的无图标的飞跃提示实现如下：
procedure TForm1.Button1Click(Sender: TObject);
begin
CreateToolTips(Form1.Handle);
AddToolTip(Memo1.Handle, @ti, 0, '测试飞跃提示', '无图标提示');
end;
图3所示的蓝色信息提示图标的飞跃提示实现如下：
procedure TForm1.Button2Click(Sender: TObject);
begin
CreateToolTips(Form1.Handle);
AddToolTip(Memo1.Handle, @ti, 1, '测试飞跃提示', '信息图标');
end;
图4所示的黄色警告图标的飞跃提示实现如下：
procedure TForm1.Button3Click(Sender: TObject);
begin
CreateToolTips(Form1.Handle);
AddToolTip(Memo1.Handle, @ti, 2, '测试飞跃提示', '警告图标');
end;
图5所示的红色错误图标的飞跃提示实现如下：
procedure TForm1.Button4Click(Sender: TObject);
begin
CreateToolTips(Form1.Handle);
AddToolTip(Memo1.Handle, @ti, 3, '测试飞跃提示', '错误图标');
end;
其实，还有很多的方法实现多姿多彩的飞跃提示，比如直接使用标签控件来模拟等，但是本文提供了一个创建窗口子类的方法，如果灵活使用，一定会使你的程序大方光彩。

不过楼主把这个功能做成了DLL 劳动还是值得肯定的[]

TO:dingbaosheng
不是我说你啊,
你把代码弄成程序,看看效果是不是一样.

你的结果是:当鼠标放在上面才会显示.

LZ 能给我发一份吗。。。非常感谢。
EMail:sfgvvv__@126.com

注意看,内容里面有下载地址.

下载看看

顶顶

网上太多，无暇下载

TO:kinneng
你下载看了,跟网上不一样
最少在国内网站还没有找得到.

还WINDOWS的相比，还缺少阴影效果，

TO:wiseinfo
谢谢回复,可以增加&quot;阴影效果&quot;

好东东哦

to jey
网上确实每一个都不一样，我大概也不会统统搬回家，除非有钱途。