国产高清在线免费观看-国产高清在线免费无码-国产高清在线男人的天堂-国产高清在线视频-国产高清在线视频精品视频-国产高清在线视频伊甸园

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