巧用SendMessage函数扩展Treeview功能
来源:互联网 发布:郭沫若和鲁迅比 知乎 编辑:程序博客网 时间:2024/05/17 09:11
Option Explicit
Private Type TPoint
x As Long
y As Long
End Type
Private Type TVHITTESTINFO
pt As TPoint
flags As Long
hItem As Long
End Type
Private Type TVITEM
mask As Long
HTreeItem As Long
state As Long
stateMask As Long
pszText As Long
cchTextMax As Long
iImage As Long
iSelectedImage As Long
cChildren As Long
lParam As Long
End Type
Const TV_FIRST [color=#0000ff]= &H1100
Const TVM_HITTEST = TV_FIRST + 17
Const TVM_GETITEM = TV_FIRST + 12
Const TVHT_ONITEMLABEL = &H4
Const TVIF_TEXT = &H1
Const GMEM_FIXED = &H0
'设置行高
Const TVM_SETITEMHEIGHT = TV_FIRST + 27
'设置背景色
Const TVM_SETBKCOLOR = TV_FIRST + 29
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 Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (ByVal Destination As String, ByVal Source As Long, ByVal Length As Long)
Private Declare Function GlobalAlloc Lib "kernel32" (ByVal wFlags As Long, ByVal dwBytes As Long) As Long
Private Declare Function GlobalFree Lib "kernel32" (ByVal hMem As Long) As Long
Dim hItemPrv As Long
Private Sub Form_Load()
Dim ndX As Node
'加入若干Item
Set ndX = TreeView1.Nodes.Add(, , "R", "Root", 1)
Set ndX = TreeView1.Nodes.Add("R", tvwChild, "Key1", "Node1", 1)
Set ndX = TreeView1.Nodes.Add("Key1", tvwChild, "SubKey1", "SubNode1", 3)
Set ndX = TreeView1.Nodes.Add("SubKey1", tvwChild, "SubKeys1", "SubNode1", 3)
Set ndX = TreeView1.Nodes.Add("Key1", tvwChild, "SubKey2", "SubNode2")
Set ndX = TreeView1.Nodes.Add("Key1", tvwChild, "SubKey3", "SubNode3")
Set ndX = TreeView1.Nodes.Add("Key1", tvwChild, "SubKey4", "SubNode4")
'设置树型列表控件节点行(Node)高度
Call SendMessage(TreeView1.hwnd, TVM_SETITEMHEIGHT, 30, 0)
'设置树型列表控件的背景颜色
Call SendMessage(TreeView1.hwnd, TVM_SETBKCOLOR, 0, RGB(255, 0, 0))
End Sub
'为树型列表控件(Treeview)中不同的节点行(Node)设置不同的Tooltips气泡提示
'在TVM类消息中有一个TVM_HITTEST消息,发送该消息可以检测控件表面上的某一点,
'如果该点位于一个标题上,则返回该标题的句柄。而利用TVM_GETITEM消息,则可以
'根据标题句柄返回该标题行的文本。所以结合利用这两个消息可以获取光标所在标题行的标题文本.
Private Sub TreeView1_MouseMove(Button As Integer, Shift As Integer, x As Single, y As Single)
Dim ptA As TPoint
Dim tf As TVHITTESTINFO
Dim TV As TVITEM
Dim hStr As Long
Dim hItem As Long
Dim astr As String * 1024
Dim bstr
On Error GoTo errLab
'获得当前光标所在的位置坐标
ptA.x = Int(x / Screen.TwipsPerPixelX)
ptA.y = Int(y / Screen.TwipsPerPixelY)
tf.pt = ptA
tf.flags = TVHT_ONITEMLABEL
'获得光标所在的Item的句柄
hItem = SendMessage(TreeView1.hwnd, TVM_HITTEST, 0, tf)
'如果未获得句柄或者同上一次是同一个Item的句柄则退出
If ((hItem <= 0) or (hItem = hItemPrv)) Then Exit Sub
hItemPrv = hItem
'分配一定的内存空间用以存储Item的标题
hStr = GlobalAlloc(GMEM_FIXED, 1024)
If hStr > 0 Then
TV.mask = TVIF_TEXT
'获取标题文本
TV.HTreeItem = hItem
'Item句柄
TV.pszText = hStr
TV.cchTextMax = 1023
'发送TVM_GETITEM获得标题文本
Call SendMessage(TreeView1.hwnd, TVM_GETITEM, 0, TV)
'将标题文本拷贝到字符串astr中
CopyMemory astr, hStr, 1024
bstr = Left$(astr, (InStr(astr, Chr$(0)) - 1))
TreeView1.ToolTipText = bstr
'释放分配的内存空间
GlobalFree hStr
End If
Exit Sub
errLab:
Resume Next
End Sub
- 巧用SendMessage函数扩展Treeview功能
- 巧用SendMessage函数扩展Treeview功能
- 扩展jQuery函数功能
- SendMessage函数
- SendMessage函数
- 函数----SendMessage
- SendMessage 函数
- SendMessage函数
- SendMessage函数
- SendMessage函数
- 为SYSMETS加上键盘处理功能(SendMessage函数)
- SendMessage功能(中规中矩)
- 扩展 TreeView 控件
- 扩展 TreeView 控件
- 用户控件,扩展TreeView
- TreeView控件扩展
- 功能强大的SendMessage函数
- SENDMESSAGE函数巧应用
- 公告:暂停维护本博客
- 重启机子,得到剩余内存
- 一个API方式存取日志文件的模块
- OO系统设计师之路--分析模型系列(1)--什么是分析模型 [从老博客搬家至此]
- 内存泄露检测工具
- 巧用SendMessage函数扩展Treeview功能
- 【Entity FrameWork】从零开始第一步
- UML笔记(五)
- what...how...
- 让MSflexgrid支持鼠标滚轮事件
- TCP套接字解释 状态意义
- 各种Excel VBA的命令
- 如何实现VB与EXCEL的无缝连接
- 阿里旺旺垃圾消息分析及解决方案探讨