日韩欧美国产精品免费一二-日韩欧美国产精品亚洲二区-日韩欧美国产精品专区-日韩欧美国产另-日韩欧美国产免费看-日韩欧美国产免费看清风阁

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
'設(shè)置行高
Const TVM_SETITEMHEIGHT = TV_FIRST + 27
'設(shè)置背景色
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")
    
  '設(shè)置樹(shù)型列表控件節(jié)點(diǎn)行(Node)高度
    Call SendMessage(TreeView1.hwnd, TVM_SETITEMHEIGHT, 30, 0)
  '設(shè)置樹(shù)型列表控件的背景顏色
    Call SendMessage(TreeView1.hwnd, TVM_SETBKCOLOR, 0, RGB(255, 0, 0))

End Sub

'為樹(shù)型列表控件(Treeview)中不同的節(jié)點(diǎn)行(Node)設(shè)置不同的Tooltips氣泡提示
'在TVM類消息中有一個(gè)TVM_HITTEST消息，發(fā)送該消息可以檢測(cè)控件表面上的某一點(diǎn)，
'如果該點(diǎn)位于一個(gè)標(biāo)題上，則返回該標(biāo)題的句柄。而利用TVM_GETITEM消息，則可以
'根據(jù)標(biāo)題句柄返回該標(biāo)題行的文本。所以結(jié)合利用這兩個(gè)消息可以獲取光標(biāo)所在標(biāo)題行的標(biāo)題文本.
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

    '獲得當(dāng)前光標(biāo)所在的位置坐標(biāo)

    ptA.x = Int(x / Screen.TwipsPerPixelX)

    ptA.y = Int(y / Screen.TwipsPerPixelY)

    tf.pt = ptA

    tf.flags = TVHT_ONITEMLABEL

    '獲得光標(biāo)所在的Item的句柄

    hItem = SendMessage(TreeView1.hwnd, TVM_HITTEST, 0, tf)

    '如果未獲得句柄或者同上一次是同一個(gè)Item的句柄則退出

    If ((hItem <= 0) or (hItem = hItemPrv)) Then Exit Sub

    hItemPrv = hItem

    '分配一定的內(nèi)存空間用以存儲(chǔ)Item的標(biāo)題

    hStr = GlobalAlloc(GMEM_FIXED, 1024)

    If hStr > 0 Then

        TV.mask = TVIF_TEXT

        '獲取標(biāo)題文本

        TV.HTreeItem = hItem

        'Item句柄

        TV.pszText = hStr

        TV.cchTextMax = 1023

        '發(fā)送TVM_GETITEM獲得標(biāo)題文本

        Call SendMessage(TreeView1.hwnd, TVM_GETITEM, 0, TV)

        '將標(biāo)題文本拷貝到字符串a(chǎn)str中

        CopyMemory astr, hStr, 1024

        bstr = Left$(astr, (InStr(astr, Chr$(0)) - 1))

        TreeView1.ToolTipText = bstr

        '釋放分配的內(nèi)存空間

        GlobalFree hStr

    End If

    Exit Sub

errLab:

    Resume Next

End Sub