【转】实现多行toolTips的类模块
这里有一个类模块,就是用来实现多行 toolTips 的.
Option Explicit
'============================================================='
' Module Name : mdlAPI
' Written By : Gordon Robinson
' Date : 08/05/2000
' Comments :
'
'============================================================='
'============================================================='
' Constants
'============================================================='
Private Const TTS_ALWAYSTIP = &H1
Private Const TTS_NOPREFIX = &H2
Private Const CW_USEDEFAULT = &H80000000
Private Const WS_POPUP = &H80000000
Private Const WM_USER = &H400
Private Const TTM_ADDTOOL = WM_USER + 4
Private Const TTM_SETMAXTIPWIDTH = WM_USER + 24
Private Const TTM_SETDELAYTIME = WM_USER + 3
Private Const TTM_GETDELAYTIME = WM_USER + 21
Private Const TTDT_AUTOMATIC = 0
Private Const TTDT_RESHOW = 1
Private Const TTDT_AUTOPOP = 2
Private Const TTDT_INITIAL = 3
Private Const TTF_SUBCLASS = &H10
Private Const TTF_IDISHWND = &H1
Private Const TTF_CENTERTIP = &H2
'============================================================='
' Types
'============================================================='
Private Type RECT
Left As Long
Top As Long
Right As Long
Bottom As Long
End Type
Private Type TOOLINFO
cbSize As Long
uFlags As Long
hwnd As Long
uId As Long
cRect As RECT
hinst As Long
lpszText As String
End Type
'============================================================='
' API Functions
'============================================================='
Private Declare Function CreateWindowEx Lib "user32" Alias "CreateWindowExA" _
(ByVal dwExStyle As Long, _
ByVal lpClassName As String, _
ByVal lpWindowName As String, _
ByVal dwStyle As Long, _
ByVal x As Long, _
ByVal y As Long, _
ByVal nWidth As Long, _
ByVal nHeight As Long, _
ByVal hWndParent As Long, _
ByVal hMenu As Long, _
ByVal hInstance As Long, _
lpParam As Any) _
As Long
Private Declare Function DestroyWindow Lib "user32" _
(ByVal hwnd As Long) _
As Long
Private Declare Function GetClientRect Lib "user32" _
(ByVal hwnd As Long, _
lpRect As RECT) _
As Long
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" _
(ByVal hwnd As Long, _
ByVal wMsg As Long, _
ByVal wParam As Long, _
lParam As Any) _
As Long
Private Declare Function SendMessageLong Lib "user32" Alias "SendMessageA" _
(ByVal hwnd As Long, _
ByVal wMsg As Long, _
ByVal wParam As Long, _
ByVal lParam As Long) _
As Long
'====================================================================='
' Member Variables
'====================================================================='
Private m_lngHwnd As Long
Private m_lngMaxWidth As Long
'====================================================================='
' Properties
'====================================================================='
Public Property Get MaxWidth() As Long
MaxWidth = m_lngMaxWidth
End Property
Public Property Let MaxWidth(lngMaxWidth As Long)
m_lngMaxWidth = lngMaxWidth
SendMessageLong m_lngHwnd, TTM_SETMAXTIPWIDTH, 0, m_lngMaxWidth
End Property
Public Property Get VisibleTime() As Long
VisibleTime = SendMessageLong(m_lngHwnd, TTM_GETDELAYTIME, TTDT_AUTOPOP, 0)
End Property
Public Property Let VisibleTime(lngTime As Long)
If lngTime > 32767 Then lngTime = 32767
If lngTime < 0 Then lngTime = 0
SendMessageLong m_lngHwnd, TTM_SETDELAYTIME, TTDT_AUTOPOP, lngTime
End Property
Public Property Get DelayTime() As Long
DelayTime = SendMessageLong(m_lngHwnd, TTM_GETDELAYTIME, TTDT_INITIAL, 0)
End Property
Public Property Let DelayTime(lngTime As Long)
If lngTime > 32767 Then lngTime = 32767
If lngTime < 0 Then lngTime = 0
SendMessageLong m_lngHwnd, TTM_SETDELAYTIME, TTDT_INITIAL, lngTime
End Property
'====================================================================='
' Methods
'====================================================================='
Public Sub Create(lngHwndParent As Long)
m_lngHwnd = CreateWindowEx(0, _
"tooltips_class32", _
0, _
TTS_NOPREFIX Or TTS_ALWAYSTIP, _
CW_USEDEFAULT, _
CW_USEDEFAULT, _
CW_USEDEFAULT, _
CW_USEDEFAULT, _
lngHwndParent, _
0, _
App.hInstance, _
0)
SendMessageLong m_lngHwnd, TTM_SETMAXTIPWIDTH, 0, m_lngMaxWidth
End Sub
Public Sub Destroy()
DestroyWindow m_lngHwnd
End Sub
Public Sub AddControl(ctlTool As Object, strCaption As String, Optional blnCenterTip As Boolean = False)
Dim udtToolInfo As TOOLINFO
With udtToolInfo
GetClientRect ctlTool.hwnd, .cRect
.hwnd = ctlTool.hwnd
.uFlags = TTF_IDISHWND Or TTF_SUBCLASS
If blnCenterTip Then
.uFlags = .uFlags Or TTF_CENTERTIP
End If
.uId = ctlTool.hwnd
.lpszText = strCaption
.cbSize = Len(udtToolInfo)
End With
SendMessage m_lngHwnd, TTM_ADDTOOL, 0, udtToolInfo
End Sub
'====================================================================='
' Events
'====================================================================='
Private Sub Class_Initialize()
m_lngMaxWidth = 300
End Sub
【使用方法】
将上面那段源程序存为一个类模块,名为 cTooltop
首先应该建立一个form然后在form上添加文本框：复选框chkAddToCurrentGroup，txtemail,txttelephone,...然后就可以了
然后在窗体的 Form_Load 中写如下代码即可.
Dim ct As New cTooltip
'========================================================
'设置多行的提示信息
ct.Create Me.hwnd '父窗体句柄
ct.DelayTime = 100 '延迟时间
ct.VisibleTime = 5000 '显示时间
ct.AddControl chkAddToCurrentGroup, "如果选中此项,那么数据录入时," & vbCrLf & _
"同时将此记录加入当前选中了的分组。" & vbCrLf & _
"如果选中了多个组，那么它将加入多个组"
ct.AddControl txtAddress, "这里的地址是指除去省名、地区之外的更详细的地址。" & vbCrLf & _
"也就是说,这里不必也不能填写省名、地区了。" & vbCrLf & _
"例如: 广东省广州市中山八路 8888 号" & vbCrLf & _
"在此只需填写 “中山八路 8888 号”即可"
ct.AddControl txtUnit, "这里填写单位、公司。" & vbCrLf & _
"如:大发公司财务处"
ct.AddControl txtTelephone, "你可以在此快速录入电话号码." & vbCrLf & _
"号码之间以分号(;)分隔." & vbCrLf & _
"电话号码以类别字母开头(缺省认为家庭电话)" & vbCrLf & _
"类别字母为(注意数字 0 与字母 o 的区别):" & vbCrLf & _
"o 办公 h 家庭 m 移动 f 传真 c 呼机" & vbCrLf & _
"例如:o020-87332053-8888;m13660888888;c95950-88888"
ct.AddControl txtEmail, "你可以在此快速录入电子邮箱." & vbCrLf & _
"邮箱之间以分号(;)分隔." & vbCrLf & _
"如:yourgod@god.com;mygod@god.net"
转载于:https://www.cnblogs.com/feima-lxl/archive/2008/06/23/1228218.html
【转】实现多行toolTips的类模块相关推荐
- [转]Python 命令行参数和getopt模块详解
FROM : http://www.tuicool.com/articles/jaqQvq 有时候我们需要写一些脚本处理一些任务,这时候往往需要提供一些命令行参数,根据不同参数进行不同的处理,在Pyt ...
- python 命令行参数处理 getopt模块详解
有时候我们需要写一些脚本处理一些任务,这时候往往需要提供一些命令行参数,根据不同参数进行不同的处理,在Python里,命令行的参数和C语言很类似(因为标准Python是用C语言实现的).在C语言里,m ...
- VB中窗体模块、标准模块、类模块的区别
VB的代码存储在模块中.在VB中提供了三种类型的模块:窗体模块.标准模块和类模块. 简单的应用程序可以只有一个窗体,所用的程序都驻留在窗体模块中,而当应用程序庞大复杂时,就要另外附加窗体.最终可能有几 ...
- VB中什么是类，类模块有什么作用
一.什么是类? 用面向对象的编程思想来看,类就是存储数据同时给一组相关代码赋予协调功能的方式.类是面向对象编程的核心. VB最为人垢病的是它的面向对象特性.实际上VB是一种基于对象的开发工具.在VB中 ...
- VBA 类模块理解和使用总结
目 录 VBA 类模块理解和使用总结 一.类的概念 二.类的定义 三.类详细定义 关于封装 关于多态 关于异常 关于自定义事件 四.结论: VBA 类模块理解和使用总结 一.类的概念 记得有人总结,V ...
- Excel VBA（09）类模块和数据库操作
类模块详解 一.类模块入门 vba 中的类模块的概念和其他面向对象的语言里面的类的概念是类似的,就是抽取共性进行封装以便能够重复使用 类模块的插入 类模块的相关语句如下 1.let:设置对象属性 2. ...
- vba 定义类_VBA｜自定义类型、枚举类型和类模块及其使用
VBA中,自定义类型相当于C语言中的结构体,枚举类型也与C语言中的枚举类型相似.自定义类型和枚举类型放到模块的子过程的前面即可. VBA中, 类模块相当于C语言中的类,类模板要单独放到类模块中(自定义 ...
- ansible笔记（8）：常用模块之系统类模块（二）
ansible笔记(8):常用模块之系统类模块(二)user模块 user模块可以帮助我们管理远程主机上的用户,比如创建用户.修改用户.删除用户.为用户创建密钥对等操作.此处我们介绍一些user模块的 ...
- 计算机模块的概念,用户定义类模块概念-计算机二级-Access
本节课讲解[VBA - 用户定义类模块概念]同学们可以在下方评论区进行留言. 那我们开始今天的教程吧. 1.用户定义类模块由其属性和属性过程.方法及时间封装构成,"属性和属性过程" ...
最新文章
- Go 学习笔记（60）— Go 第三方库之 go-redis（初始化 redis、操作 string、操作 list、操作 set、操作 hset）
- pjax php,ZBlogPHP简单实现pjax的一种方法
- 讲讲 Redis 缓存更新一致性
- 【Flutter】Flutter 混合开发 ( 安卓端向 Flutter 传递数据 | FlutterFragment 数据传递 | FlutterActivity 数据传递 )
- 怎么在linux中查询yum,linux - 如何使用YUM列出包的内容？
- 第1届ICPC青少年程序设计竞赛（正式赛）A 题 - Divide
- Xilinx Zynq-7000 嵌入式系统设计与实现
- java 实现不同用户编辑 word 文档的不同区域
- C语言 SDK编程之通用控件的使用－－ListView
- 今天突然出现了Property IsLocked is not available for Login '[sa]'，我太阳，下面有绝招对付它！...
- 迅睿CMS插件自动采集伪原创免费插件
- Ubuntu中安装和使用vim
- MATLAB/Simulink仿真 并网型风光混储直流微电网 实现：功率分配、削峰填谷、平抑功率波
- 微信群发工具，纯Python编写~
- PPT文件不能编辑怎么回事？
- C语言之：数组的定义和初始化必备练习题
- 老外名字中间的点怎么输入 微软拼音 @
- 11,MSI文件简介
- Android 获得手机屏幕大小
- 如何反编译pyc文件查看源代码