Option ExplicitPrivate Type TPoint x As Long y As LongEnd TypePrivate Type TVHITTESTINFO pt As TPoint flags As Long hItem As LongEnd TypePrivate 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 LongEnd TypeConst TV_FIRST [color=#0000ff]= &H1100Const TVM_HITTEST = TV_FIRST + 17Const TVM_GETITEM = TV_FIRST + 12Const TVHT_ONITEMLABEL = &H4Const TVIF_TEXT = &H1Const GMEM_FIXED = &H0'设置行高Const TVM_SETITEMHEIGHT = TV_FIRST + 27'设置背景色Const TVM_SETBKCOLOR = TV_FIRST + 29Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As LongPrivate 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 LongPrivate Declare Function GlobalFree Lib "kernel32" (ByVal hMem As Long) As LongDim hItemPrv As LongPrivate 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 SuberrLab: Resume NextEnd Sub
