linux社区爱心援助Linux认证系列教程业界动态站务新闻公司招聘网络学院网址大全LPI专题CISCO专题
设为首页
加入收藏
管理团队
JSP  
JAVA  
PERL  
 您的位置:首页 > 开发语言 > Delphi >
栏目导栏
  php
  JSP
  ASP
  asp.net
  JAVA
  c/c++/c#
  perl
  JavaScript
  Basic
  Delphi
资料搜索
热门文章
·HexToStr函数和StrToHex函数
·Delphi中的进制转换
·delphi轻松设置无边框透明窗体
·delphi第三方控件安装(Ehlib)
·DELPHI组件安装全攻略
·delphi动态创建控件
·开发工具比较Visual C++ VS De
·delphi完整身份证效验程序实例
·delphi中的Format函数详解
·delphi编程获取打印机的打印任
·如何判断文本文件的编码格式
·深入研究Variant数组
·用delphi编写网络游戏的外挂
·Delphi技巧-用户自定义数据类型
·delphi设置控件透明
最新文章
·在应用程序中跟踪MOUSE的坐标
·压缩和修复MS Access 2000文件
·DELPHI 6.0 动画制做
·怎样在Delphi中调用LastError信
·怎样得到主域服务器名称
·怎样利用递归实现删除某一目录
·读出主键下所有项
·如何制作照片底片效果的图像(
·获得Modem的状态
·WebBrowser屏幕滚动的实现,设
·有关字符串处理的小技巧
·Delphi建立键盘鼠标动作纪录与
·Delphi中布尔类型辨析
·DELPHI程序注册码设计
·图形的不规则的Copy
Google
 
创建漂亮的气球提示(balloon tooltips)
[ 作者:  加入时间:2007-10-30 15:52:37  来自:Linux联盟收集整理 ]
创建漂亮的气球提示:qfKLinux联盟
qfKLinux联盟
qfKLinux联盟
{....}qfKLinux联盟
qfKLinux联盟
uses Commctrl;qfKLinux联盟
qfKLinux联盟
{....}qfKLinux联盟
qfKLinux联盟
constqfKLinux联盟
TTS_BALLOON    = $40;qfKLinux联盟
TTM_SETTITLE = (WM_USER + 32);qfKLinux联盟
qfKLinux联盟
varqfKLinux联盟
hTooltip: Cardinal;qfKLinux联盟
ti: TToolInfo;qfKLinux联盟
buffer : array[0..255] of char;qfKLinux联盟
qfKLinux联盟
{....}qfKLinux联盟
qfKLinux联盟
qfKLinux联盟
qfKLinux联盟
procedure CreateToolTips(hWnd: Cardinal);qfKLinux联盟
beginqfKLinux联盟
  hToolTip := CreateWindowEx(0, 'Tooltips_Class32', nil, TTS_ALWAYSTIP or TTS_BALLOON,qfKLinux联盟
  Integer(CW_USEDEFAULT), Integer(CW_USEDEFAULT), Integer(CW_USEDEFAULT),qfKLinux联盟
  Integer(CW_USEDEFAULT), hWnd, 0, hInstance, nil);qfKLinux联盟
  if hToolTip <> 0 thenqfKLinux联盟
  beginqfKLinux联盟
    SetWindowPos(hToolTip, HWND_TOPMOST, 0, 0, 0, 0, SWP_NOMOVE orqfKLinux联盟
    SWP_NOSIZE or SWP_NOACTIVATE);qfKLinux联盟
    ti.cbSize := SizeOf(TToolInfo);qfKLinux联盟
    ti.uFlags := TTF_SUBCLASS;qfKLinux联盟
    ti.hInst  := hInstance;qfKLinux联盟
  end;qfKLinux联盟
end;qfKLinux联盟
qfKLinux联盟
procedure AddToolTip(hwnd: DWORD; lpti: PToolInfo; IconType: Integer;qfKLinux联盟
Text, Title: PChar);qfKLinux联盟
varqfKLinux联盟
Item: THandle;qfKLinux联盟
Rect: TRect;qfKLinux联盟
beginqfKLinux联盟
  Item := hWnd;qfKLinux联盟
  if (Item <> 0) and (GetClientRect(Item, Rect)) thenqfKLinux联盟
  beginqfKLinux联盟
    lpti.hwnd := Item;qfKLinux联盟
    lpti.Rect := Rect;qfKLinux联盟
    lpti.lpszText := Text;qfKLinux联盟
    SendMessage(hToolTip, TTM_ADDTOOL, 0, Integer(lpti));qfKLinux联盟
    FillChar(buffer, SizeOf(buffer), #0);qfKLinux联盟
    lstrcpy(buffer, Title);qfKLinux联盟
    if (IconType > 3) or (IconType < 0) then IconType := 0;qfKLinux联盟
    SendMessage(hToolTip, TTM_SETTITLE, IconType, Integer(@buffer));qfKLinux联盟
  end;qfKLinux联盟
end;qfKLinux联盟
qfKLinux联盟
procedure TForm1.Button1Click(Sender: TObject);qfKLinux联盟
beginqfKLinux联盟
  CreateToolTips(Form1.Handle);qfKLinux联盟
  AddToolTip(Memo1.Handle, @ti, 1, 'Tooltip text', 'Title');qfKLinux联盟
end;qfKLinux联盟
qfKLinux联盟
{qfKLinux联盟
IconType can be:qfKLinux联盟
qfKLinux联盟
0 - No iconqfKLinux联盟
1 - InformationqfKLinux联盟
2 - WarningqfKLinux联盟
3 - ErrorqfKLinux联盟
}
Linux联盟收集整理 ,转贴请标明原始链接,如有任何疑问欢迎来本站Linux论坛讨论
评论】【加入收藏夹】【 】【打印】【关闭
※ 相关链接
无相关信息