[RESOLVED] VB6 - QUESTION - Is it possible to add tooltiptext to individual items in a treeview?

[yereverluvinuncleber]

I was adding some folders to a treeview control and wanted each node in the tree to have its own defined tooltip. In particular I wanted the parent node to have a tooltiptext to alert the user about something.

However, it seems that I can only assign one tooltiptext to the whole control. Am I correct in this assumption?

[dilettante]

Correct. I can't find anything supporting tooltips for every node.

[yereverluvinuncleber]

Bluggeration, never mind, thanks for the assistance, I think it may be possible with VB.NET and will consider that when I upgrade my utility.

[Arnoutdv]

In the MouseMove event you can change the tooltip content when the mouse hovers over a node.

You can use the .HitTest function for this.

http://www.vbforums.com/showthread.p...MouseOver-Node

[Elroy]

I had it for the ListView, so I knew I could do it for the TreeView. Over the last 30 minutes or so, I've patched something together (above video). I didn't get my mouse pointer in the video, but you get the idea.

The code is still very rough, but it's working. A test project is attached.

I might spend a bit more time and do further clean-up. I (or someone) really needs to figure out how to eliminate that loop to get from a hItem to a IndexItem. I'm sure there's a way. I just didn't have it handy.

EDIT1: Gonna eat some breakfast now, so any ideas on how to get from hItem to IndexItem without that loop are more than welcome.

[yereverluvinuncleber]

Ah, I see, so we respond to a Mouseover event and then change the whole treeview control tooltiptext until it reaches another node, where we do it again. That is useful, I will have to give it a go. Thanks for that.

[yereverluvinuncleber]

I do love VB6.

[Elroy]

Ah, I see, so we respond to a Mouseover event and then change the whole treeview control tooltiptext until it reaches another node, where we do it again. That is useful, I will have to give it a go. Thanks for that.

Well, that's not exactly what I did, but close. I just "built" a ToolTipText out of the Tag for each node. And I use the Node's Text for the caption of the ToolTip. I'm now full of breakfast, so let me see if I can clean that code up a bit.

[Elroy]

Ok, I've done some more studying, and also cleaned up the code some more, and I've become convinced that the loop is the only way to get a Node's index from its hItem (handle).

Here's my cleaned up code. This works with the TreeView found in mscomctl.ocx. Although, I think it'll also work with comctl32.ocx (but not tested). Also, my "test" TreeView is named treTest.

Option Explicit
'
Private Declare Function SendMessageLongA Lib "user32" Alias "SendMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Private Declare Function SendMessageA Lib "user32" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByRef lParam As Any) As Long



'
' ToolTip Stuff.
'
Private Type TOOLINFO
    lSize       As Long
    lFlags      As Long
    hWnd        As Long
    lId         As Long
    '
    'lpRect      As RECT
    Left        As Long
    Top         As Long
    Right       As Long ' This is +1 (right - left = width)
    Bottom      As Long ' This is +1 (bottom - top = height)
    '
    hInstance   As Long
    lpStr       As String
    lParam      As Long
End Type
'
Private Declare Sub InitCommonControls Lib "comctl32" ()
Private Declare Function CreateWindowExW Lib "user32" (ByVal dwExStyle As Long, ByVal lpClassName As Long, ByVal lpWindowName As Long, 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 Const WM_USER               As Long = &H400&
Private Const CW_USEDEFAULT         As Long = &H80000000
'
Private Const TTM_ACTIVATE          As Long = WM_USER + 1&
'Private Const TTM_ADDTOOLA          As Long = WM_USER + 4&
Private Const TTM_ADDTOOLW          As Long = WM_USER + 50&
Private Const TTM_SETDELAYTIME      As Long = WM_USER + 3&
'Private Const TTM_UPDATETIPTEXTA    As Long = WM_USER + 12&
Private Const TTM_UPDATETIPTEXTW    As Long = WM_USER + 57&
Private Const TTM_SETTIPBKCOLOR     As Long = WM_USER + 19&
Private Const TTM_SETTIPTEXTCOLOR   As Long = WM_USER + 20&
Private Const TTM_SETMAXTIPWIDTH    As Long = WM_USER + 24&
'Private Const TTM_SETTITLEA         As Long = WM_USER + 32&
Private Const TTM_SETTITLEW         As Long = WM_USER + 33&
'
Private Const TTS_NOPREFIX          As Long = &H2&
Private Const TTS_BALLOON           As Long = &H40&
Private Const TTS_ALWAYSTIP         As Long = &H1&
'
Private Const TTF_CENTERTIP         As Long = &H2&
Private Const TTF_IDISHWND          As Long = &H1&
Private Const TTF_SUBCLASS          As Long = &H10&
Private Const TTF_TRANSPARENT       As Long = &H100&
'
Private Const TTDT_AUTOPOP          As Long = 2&
Private Const TTDT_INITIAL          As Long = 3&
'
Private Const TOOLTIPS_CLASS        As String = "tooltips_class32"
'
Private Const GWL_EXSTYLE           As Long = &HFFFFFFEC
Private Const WS_EX_TOOLWINDOW      As Long = &H80&
Private Const WS_EX_TOPMOST         As Long = &H8&
'
Private Enum ttIconType
    TTNoIcon
    TTIconInfo
    TTIconWarning
    TTIconError
End Enum
#If False Then ' Intellisense fix.
    Private TTNoIcon, TTIconInfo, TTIconWarning, TTIconError
#End If
'
Private hwndTT As Long ' hwnd of the tooltip



'
' TreeView stuff.
'
Private Enum TVHT_flags
    TVHT_NOWHERE = &H1&             ' In the client area, but below the last item
    TVHT_ONITEMICON = &H2&
    TVHT_ONITEMLABEL = &H4&
    TVHT_ONITEMINDENT = &H8&
    TVHT_ONITEMBUTTON = &H10&
    TVHT_ONITEMRIGHT = &H20&
    TVHT_ONITEMSTATEICON = &H40&
    TVHT_ONITEM = (TVHT_ONITEMICON Or TVHT_ONITEMLABEL Or TVHT_ONITEMSTATEICON)
    TVHT_ONITEMLINE = (TVHT_ONITEM Or TVHT_ONITEMINDENT Or TVHT_ONITEMBUTTON Or TVHT_ONITEMRIGHT)
    TVHT_ABOVE = &H100&
    TVHT_BELOW = &H200&
    TVHT_TORIGHT = &H400&
    TVHT_TOLEFT = &H800&
End Enum
#If False Then ' Intellisense fix.
    Private TVHT_NOWHERE, TVHT_ONITEMICON, TVHT_ONITEMLABEL, TVHT_ONITEMINDENT, TVHT_ONITEMBUTTON, TVHT_ONITEMRIGHT, TVHT_ONITEMSTATEICON
    Private TVHT_ONITEM, TVHT_ONITEMLINE, TVHT_ABOVE, TVHT_BELOW, TVHT_TORIGHT, TVHT_TOLEFT
#End If
'
Private Type POINTAPI
    x As Long
    y As Long
End Type
'
Private Type TVHITTESTINFO
    pt As POINTAPI
    lFlags As TVHT_flags
    hItem As Long
End Type
'
Private Const TVM_FIRST              As Long = &H1100&
Private Const TVM_GETNEXTITEM        As Long = (TVM_FIRST + 10&)
Private Const TVM_GETITEM            As Long = (TVM_FIRST + 12&)
Private Const TVM_HITTEST            As Long = (TVM_FIRST + 17&)
'
Private Type TVITEM
    mask As Long
    hItem As Long
    state As Long
    stateMask As Long
    pszText As Long    ' if a string, must be pre-allocated!!
    cchTextMax As Long
    iImage As Long
    iSelectedImage As Long
    cChildren As Long
    lParam As Long
End Type
'
Private Const TVGN_CARET = &H9&
'







Private Sub Form_Load()
    Dim oNode As Node
    '
    ' Just some test data for the TreeView.
    '
    Set oNode = treTest.Nodes.Add(, tvwNext, , "Top Node One")
    oNode.Tag = "Top Node One ToolTip"
    Set oNode = treTest.Nodes.Add(, tvwNext, , "Top Node Two")
    oNode.Tag = "Top Node Two ToolTip"
    '
    Set oNode = treTest.Nodes.Add(1, tvwChild, , "Child Node One A")
    oNode.Tag = "Child Node One A ToolTip"
    Set oNode = treTest.Nodes.Add(1, tvwChild, , "Child Node One B")
    oNode.Tag = "Child Node One B ToolTip"
    '
    Set oNode = treTest.Nodes.Add(2, tvwChild, , "Child Node Two A")
    oNode.Tag = "Child Node Two A ToolTip"
    Set oNode = treTest.Nodes.Add(2, tvwChild, , "Child Node Two B")
    oNode.Tag = "Child Node Two B ToolTip"
    '
End Sub

Private Sub Form_Unload(Cancel As Integer)
    DestroyToolTip
End Sub

Private Sub treTest_MouseMove(Button As Integer, Shift As Integer, x As Single, y As Single)
    Dim tvhti As TVHITTESTINFO
    Dim lItemIndex As Long
    Dim sTitle As String
    Dim sText As String
    Static lCurItemIndex As Long
    '
    tvhti.pt.x = x / Screen.TwipsPerPixelX
    tvhti.pt.y = y / Screen.TwipsPerPixelY
    SendMessageA treTest.hWnd, TVM_HITTEST, 0, tvhti
    '
    If (tvhti.lFlags And TVHT_ONITEMLINE) Then
        lItemIndex = GetTreeNodeIndexFromHandle(treTest, tvhti.hItem)
        If lCurItemIndex <> lItemIndex Then
            lCurItemIndex = lItemIndex
            If lCurItemIndex < 1 Or lCurItemIndex > treTest.Nodes.Count Then ' No item under the mouse pointer.
                DestroyToolTip
            Else
                '
                ' Here's where we show the tooltip.
                ' We'll use the node's Text as a title, 
                ' and it's Tag for our tooltip text.
                '
                sTitle = treTest.Nodes(lItemIndex).Text
                sText = treTest.Nodes(lItemIndex).Tag
                CreateToolTip treTest.hWnd, sText, , sTitle, , , , True, 60, , 30000
            End If
        End If
    Else
        DestroyToolTip
    End If
End Sub





Private Function GetTreeNodeIndexFromHandle(tre As TreeView, hNode As Long)
    Dim i As Long
    Dim h As Long
    '
    For i = 1& To tre.Nodes.Count
        h = GetTreeNodeHandle(tre, tre.Nodes(i))
        If h = hNode Then
            GetTreeNodeIndexFromHandle = i
            Exit Function
        End If
    Next
    ' Returns ZERO if we fall out.
End Function

Private Function GetTreeNodeHandle(tre As TreeView, oNode As Node) As Long
    Dim selNode As Node
    '
    Set selNode = tre.SelectedItem
    Set tre.SelectedItem = oNode
    GetTreeNodeHandle = SendMessageA(tre.hWnd, TVM_GETNEXTITEM, TVGN_CARET, ByVal 0&)
    Set tre.SelectedItem = selNode
End Function






Private Sub CreateToolTip(ByVal ParentHwnd As Long, _
                         ByVal TipText As String, _
                         Optional ByVal uIcon As ttIconType = TTNoIcon, _
                         Optional ByVal sTitle As String, _
                         Optional ByVal lForeColor As Long = -1&, _
                         Optional ByVal lBackColor As Long = -1&, _
                         Optional ByVal bCentered As Boolean, _
                         Optional ByVal bBalloon As Boolean, _
                         Optional ByVal lWrapTextLength As Long = 50&, _
                         Optional ByVal lDelayTime As Long = 200&, _
                         Optional ByVal lVisibleTime As Long = 5000&)
    '
    ' If lWrapTextLength = 0 then there will be no wrap.
    ' Also, lWrapTextLength = 40 is a minimum value.
    ' The max for lVisibleTime is 32767.
    '
    Static bCommonControlsInitialized As Boolean
    Dim lWinStyle As Long
    Dim ti As TOOLINFO
    Static PrevParentHwnd As Long
    Static PrevTipText As String
    Static PrevTitle As String
    '
    ' Don't do anything unless we need to.
    If hwndTT <> 0& And ParentHwnd = PrevParentHwnd And TipText = PrevTipText And sTitle = PrevTitle Then Exit Sub
    PrevParentHwnd = ParentHwnd
    PrevTipText = TipText
    PrevTitle = sTitle
    '
    If Not bCommonControlsInitialized Then
        InitCommonControls
        bCommonControlsInitialized = True
    End If
    '
    ' Destroy any previous tooltip.
    If hwndTT <> 0& Then DestroyWindow hwndTT
    '
    ' Format the text.
    FormatTooltipText TipText, lWrapTextLength
    '
    ' Initial style settings.
    lWinStyle = TTS_ALWAYSTIP Or TTS_NOPREFIX
    If bBalloon Then lWinStyle = lWinStyle Or TTS_BALLOON ' Create baloon style if desired.
    ' Set the style.
    hwndTT = CreateWindowExW(WS_EX_TOOLWINDOW Or WS_EX_TOPMOST, StrPtr(TOOLTIPS_CLASS), 0&, lWinStyle, CW_USEDEFAULT, CW_USEDEFAULT, CW_USEDEFAULT, CW_USEDEFAULT, 0&, 0&, App.hInstance, 0&)
    '
    ' Setup our tooltip info structure.
    ti.lFlags = TTF_SUBCLASS Or TTF_IDISHWND
    If bCentered Then ti.lFlags = ti.lFlags Or TTF_CENTERTIP
    ' Set the hwnd prop to our parent control's hwnd.
    ti.hWnd = ParentHwnd
    ti.lId = ParentHwnd
    ti.hInstance = App.hInstance
    ti.lpStr = TipText
    ti.lSize = LenB(ti)
    ' Set the tooltip structure
    SendMessageLongA hwndTT, TTM_ADDTOOLW, 0&, VarPtr(ti)
    SendMessageLongA hwndTT, TTM_UPDATETIPTEXTW, 0&, VarPtr(ti)
    '
    ' Colors.
    If lForeColor <> -1& Then SendMessageA hwndTT, TTM_SETTIPTEXTCOLOR, lForeColor, 0&
    If lBackColor <> -1& Then SendMessageA hwndTT, TTM_SETTIPBKCOLOR, lBackColor, 0&
    '
    ' Title or icon.
    If uIcon <> TTNoIcon Or sTitle <> vbNullString Then SendMessageLongA hwndTT, TTM_SETTITLEW, CLng(uIcon), StrPtr(sTitle)
    '
    SendMessageLongA hwndTT, TTM_SETDELAYTIME, TTDT_AUTOPOP, lVisibleTime
    SendMessageLongA hwndTT, TTM_SETDELAYTIME, TTDT_INITIAL, lDelayTime
End Sub

Private Sub DestroyToolTip()
    ' It's not a bad idea to put this in the Form_Unload event just to make sure.
    If hwndTT <> 0& Then DestroyWindow hwndTT
    hwndTT = 0&
End Sub

Private Sub FormatTooltipText(TipText As String, lLen As Long)
    Dim s As String
    Dim ss() As String
    Dim i As Long
    Dim j As Long
    '
    ' Make sure we need to do anything.
    If lLen = 0& Then Exit Sub
    If lLen < 40& Then lLen = 40&
    If Len(TipText) <= lLen Then Exit Sub
    '
    ss = Split(TipText, vbCrLf)                     ' We split each line separately.
    For j = LBound(ss) To UBound(ss)
        If Len(ss(j)) > lLen Then
            s = vbNullString
            Do
                i = InStrRev(ss(j), " ", lLen + 1&)
                If i = 0& Then
                    s = s & Left$(ss(j), lLen) & vbCrLf ' Build "s" and trim from TipText.
                    ss(j) = Mid$(ss(j), lLen + 1&)
                Else
                    s = s & Left$(ss(j), i - 1&) & vbCrLf ' Build "s" and trim from TipText.
                    ss(j) = Mid$(ss(j), i + 1&)
                End If
                If Len(ss(j)) <= lLen Then
                    ss(j) = s & ss(j) ' Place "s" back into ss(j) and get out.
                    Exit Do
                End If
            Loop
        End If
    Next
    TipText = Join(ss, vbCrLf)
End Sub

And let me outline some things. The module-level code has two sections: 1) stuff for the tooltips, and 2) stuff for the treeview. For the tooltips, there are three corresponding procedures: CreateToolTip, DestroyToolTip, FormatTooltipText. This is very generic and could easily be moved to a BAS module (making a few things Public).

The stuff for the treeview is also generic, and includes the GetTreeNodeIndexFromHandle and GetTreeNodeHandle procedures, and could also be moved to a BAS module for more general purpose use.

The remaining procedures (Form_Load, Form_Unload, treTest_MouseMove) are specific to this example.


Now, in this clean-up, I didn't change any of the original functionality. It turns out that code in the GetTreeNodeIndexFromHandle and GetTreeNodeHandle is about as good as I can figure out. I didn't like changing the selection in the GetTreeNodeHandle procedure. However, the fact that its put back before anything else happens hopefully means there will be no flicker and no side-effects.

Also, feel free to tweak on that code in the "show the tooltip" area of the treTest_MouseMove event. That's where decisions are made as to exactly how the tooltip is to be displayed. To appreciate other options, study the arguments in the CreateToolTip procedure.

Enjoy,
Elroy

[yereverluvinuncleber]

WoW!

[Arnoutdv]

I don’t understand why going to use all the API calls when there is a HitTest method.

[Shaggy Hiker]

Bluggeration, never mind, thanks for the assistance, I think it may be possible with VB.NET and will consider that when I upgrade my utility.

Yes, it is possible in .NET, and you may be able to do the same thing in VB6. The control is not the node, it's the TreeView. Change the tooltip based on the node. Think about how you would handle the tooltip if you were drawing directly on the form. The items you draw aren't controls, so they won't have tooltips, so if you want to have tooltips for the drawn items, you just need to know when you are over them, what the current tooltip is, and change it if the current value isn't the value it should be.

I suppose that's just a generalization of the specific answer that Elroy provided: A control can be a thing, but it can also be composed of a bunch of things. In the latter case, if you want the tooltip to reflect one of the parts of the composition, you have to know what item you are over.

[jj2007]

Check the TTN_NEEDTEXT notification.

[Elroy]

Ok, final clean-up. I eliminated the GetTreeNodeIndexFromHandle and GetTreeNodeHandle procedures, and replaced them with a new GetTreeNodeFromHandle procedure. This new procedure doesn't need a loop, and it also doesn't change the selection so there's no flicker.

Again, I used mscomctl but it should also work with comctl32, and my test TreeView is named treTest.

Option Explicit
'
Private Declare Function SendMessageLongA Lib "user32" Alias "SendMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Private Declare Function SendMessageA Lib "user32" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByRef lParam As Any) As Long
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (ByRef Dest As Any, ByRef Source As Any, ByVal Bytes As Long)
Private Declare Sub FillMemory Lib "kernel32" Alias "RtlFillMemory" (ByRef Dest As Any, ByVal length As Long, Optional ByVal Fill As Byte)


'
' ToolTip Stuff.
'
Private Type TOOLINFO
    lSize       As Long
    lFlags      As Long
    hWnd        As Long
    lId         As Long
    '
    'lpRect      As RECT
    Left        As Long
    Top         As Long
    Right       As Long ' This is +1 (right - left = width)
    Bottom      As Long ' This is +1 (bottom - top = height)
    '
    hInstance   As Long
    lpStr       As String
    lParam      As Long
End Type
'
Private Declare Sub InitCommonControls Lib "comctl32" ()
Private Declare Function CreateWindowExW Lib "user32" (ByVal dwExStyle As Long, ByVal lpClassName As Long, ByVal lpWindowName As Long, 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 Const WM_USER               As Long = &H400&
Private Const CW_USEDEFAULT         As Long = &H80000000
'
Private Const TTM_ACTIVATE          As Long = WM_USER + 1&
'Private Const TTM_ADDTOOLA          As Long = WM_USER + 4&
Private Const TTM_ADDTOOLW          As Long = WM_USER + 50&
Private Const TTM_SETDELAYTIME      As Long = WM_USER + 3&
'Private Const TTM_UPDATETIPTEXTA    As Long = WM_USER + 12&
Private Const TTM_UPDATETIPTEXTW    As Long = WM_USER + 57&
Private Const TTM_SETTIPBKCOLOR     As Long = WM_USER + 19&
Private Const TTM_SETTIPTEXTCOLOR   As Long = WM_USER + 20&
Private Const TTM_SETMAXTIPWIDTH    As Long = WM_USER + 24&
'Private Const TTM_SETTITLEA         As Long = WM_USER + 32&
Private Const TTM_SETTITLEW         As Long = WM_USER + 33&
'
Private Const TTS_NOPREFIX          As Long = &H2&
Private Const TTS_BALLOON           As Long = &H40&
Private Const TTS_ALWAYSTIP         As Long = &H1&
'
Private Const TTF_CENTERTIP         As Long = &H2&
Private Const TTF_IDISHWND          As Long = &H1&
Private Const TTF_SUBCLASS          As Long = &H10&
Private Const TTF_TRANSPARENT       As Long = &H100&
'
Private Const TTDT_AUTOPOP          As Long = 2&
Private Const TTDT_INITIAL          As Long = 3&
'
Private Const TOOLTIPS_CLASS        As String = "tooltips_class32"
'
Private Const GWL_EXSTYLE           As Long = &HFFFFFFEC
Private Const WS_EX_TOOLWINDOW      As Long = &H80&
Private Const WS_EX_TOPMOST         As Long = &H8&
'
Private Enum ttIconType
    TTNoIcon
    TTIconInfo
    TTIconWarning
    TTIconError
End Enum
#If False Then ' Intellisense fix.
    Private TTNoIcon, TTIconInfo, TTIconWarning, TTIconError
#End If
'
Private hwndTT As Long ' hwnd of the tooltip



'
' TreeView stuff.
'
Private Enum TVHT_flags
    TVHT_NOWHERE = &H1&             ' In the client area, but below the last item
    TVHT_ONITEMICON = &H2&
    TVHT_ONITEMLABEL = &H4&
    TVHT_ONITEMINDENT = &H8&
    TVHT_ONITEMBUTTON = &H10&
    TVHT_ONITEMRIGHT = &H20&
    TVHT_ONITEMSTATEICON = &H40&
    TVHT_ONITEM = (TVHT_ONITEMICON Or TVHT_ONITEMLABEL Or TVHT_ONITEMSTATEICON)
    TVHT_ONITEMLINE = (TVHT_ONITEM Or TVHT_ONITEMINDENT Or TVHT_ONITEMBUTTON Or TVHT_ONITEMRIGHT)
    TVHT_ABOVE = &H100&
    TVHT_BELOW = &H200&
    TVHT_TORIGHT = &H400&
    TVHT_TOLEFT = &H800&
End Enum
#If False Then ' Intellisense fix.
    Private TVHT_NOWHERE, TVHT_ONITEMICON, TVHT_ONITEMLABEL, TVHT_ONITEMINDENT, TVHT_ONITEMBUTTON, TVHT_ONITEMRIGHT, TVHT_ONITEMSTATEICON
    Private TVHT_ONITEM, TVHT_ONITEMLINE, TVHT_ABOVE, TVHT_BELOW, TVHT_TORIGHT, TVHT_TOLEFT
#End If
'
Private Type POINTAPI
    x As Long
    y As Long
End Type
'
Private Type TVHITTESTINFO
    pt          As POINTAPI
    lFlags      As TVHT_flags
    hitem       As Long
End Type
'
Private Type TVITEM
    mask            As Long
    hitem           As Long
    state           As Long
    stateMask       As Long
    pszText         As Long    ' if a string, must be pre-allocated!!
    cchTextMax      As Long
    iImage          As Long
    iSelectedImage  As Long
    cChildren       As Long
    lParam          As Long
End Type
'







Private Sub Form_Load()
    Dim oNode As Node
    '
    ' Just some test data for the TreeView.
    '
    Set oNode = treTest.Nodes.Add(, tvwNext, , "Top Node One")
    oNode.Tag = "Top Node One ToolTip"
    Set oNode = treTest.Nodes.Add(, tvwNext, , "Top Node Two")
    oNode.Tag = "Top Node Two ToolTip"
    '
    Set oNode = treTest.Nodes.Add(1, tvwChild, , "Child Node One A")
    oNode.Tag = "Child Node One A ToolTip"
    Set oNode = treTest.Nodes.Add(1, tvwChild, , "Child Node One B")
    oNode.Tag = "Child Node One B ToolTip"
    '
    Set oNode = treTest.Nodes.Add(2, tvwChild, , "Child Node Two A")
    oNode.Tag = "Child Node Two A ToolTip"
    Set oNode = treTest.Nodes.Add(2, tvwChild, , "Child Node Two B")
    oNode.Tag = "Child Node Two B ToolTip"
    '
End Sub

Private Sub Form_Unload(Cancel As Integer)
    DestroyToolTip
End Sub

Private Sub treTest_MouseMove(Button As Integer, Shift As Integer, x As Single, y As Single)
    Const TVM_HITTEST           As Long = &H1111&
    Dim tvhti                   As TVHITTESTINFO
    Dim oNode                   As Node
    Dim sTitle                  As String
    Dim sText                   As String
    Static lCurItemIndex        As Long
    '
    tvhti.pt.x = x / Screen.TwipsPerPixelX
    tvhti.pt.y = y / Screen.TwipsPerPixelY
    SendMessageA treTest.hWnd, TVM_HITTEST, 0, tvhti
    '
    If (tvhti.lFlags And TVHT_ONITEMLINE) Then
        Set oNode = GetTreeNodeFromHandle(treTest, tvhti.hitem)
        If lCurItemIndex <> oNode.Index Then
            lCurItemIndex = oNode.Index
            If lCurItemIndex < 1 Or lCurItemIndex > treTest.Nodes.Count Then ' No item under the mouse pointer.
                DestroyToolTip
            Else
                '
                ' Here's where we show the tooltip.
                ' We'll use the node's Text as a title,
                ' and it's Tag for our tooltip text.
                '
                sTitle = oNode.Text
                sText = oNode.Tag
                CreateToolTip treTest.hWnd, sText, , sTitle, , , , True, 60, , 30000
            End If
        End If
    Else
        DestroyToolTip
    End If
End Sub




Private Function GetTreeNodeFromHandle(tre As TreeView, hNode As Long) As Node
    ' For both the Mscomctl.ocx and Comctl32.ocx TreeView and ListView controls,
    ' the Node and ListItem's ObjPtr() values reside at the 3rd DWORD
    ' (byte offset 8) in the Node's and ListItem's lParam.
    '
    Const TVIF_PARAM    As Long = &H4&
    Const TVM_GETITEM   As Long = &H110C&
    Dim tvi             As TVITEM
    Dim pNode           As Long
    Dim oNode           As Node
    '
    tvi.hitem = hNode
    tvi.mask = TVIF_PARAM
    If SendMessageA(tre.hWnd, TVM_GETITEM, 0&, tvi) = 0& Then Exit Function
    If tvi.lParam = 0& Then Exit Function
    '
    CopyMemory pNode, ByVal tvi.lParam + 8&, 4&
    If pNode = 0& Then Exit Function
    '
    CopyMemory oNode, pNode, 4&
    Set GetTreeNodeFromHandle = oNode
    FillMemory oNode, 4&, CByte(0)    ' Clean-up.
End Function




Private Sub CreateToolTip(ByVal ParentHwnd As Long, _
                         ByVal TipText As String, _
                         Optional ByVal uIcon As ttIconType = TTNoIcon, _
                         Optional ByVal sTitle As String, _
                         Optional ByVal lForeColor As Long = -1&, _
                         Optional ByVal lBackColor As Long = -1&, _
                         Optional ByVal bCentered As Boolean, _
                         Optional ByVal bBalloon As Boolean, _
                         Optional ByVal lWrapTextLength As Long = 50&, _
                         Optional ByVal lDelayTime As Long = 200&, _
                         Optional ByVal lVisibleTime As Long = 5000&)
    '
    ' If lWrapTextLength = 0 then there will be no wrap.
    ' Also, lWrapTextLength = 40 is a minimum value.
    ' The max for lVisibleTime is 32767.
    '
    Static bCommonControlsInitialized   As Boolean
    Dim lWinStyle                       As Long
    Dim ti                              As TOOLINFO
    Static PrevParentHwnd               As Long
    Static PrevTipText                  As String
    Static PrevTitle                    As String
    '
    ' Don't do anything unless we need to.
    If hwndTT <> 0& And ParentHwnd = PrevParentHwnd And TipText = PrevTipText And sTitle = PrevTitle Then Exit Sub
    PrevParentHwnd = ParentHwnd
    PrevTipText = TipText
    PrevTitle = sTitle
    '
    If Not bCommonControlsInitialized Then
        InitCommonControls
        bCommonControlsInitialized = True
    End If
    '
    ' Destroy any previous tooltip.
    If hwndTT <> 0& Then DestroyWindow hwndTT
    '
    ' Format the text.
    FormatTooltipText TipText, lWrapTextLength
    '
    ' Initial style settings.
    lWinStyle = TTS_ALWAYSTIP Or TTS_NOPREFIX
    If bBalloon Then lWinStyle = lWinStyle Or TTS_BALLOON ' Create baloon style if desired.
    ' Set the style.
    hwndTT = CreateWindowExW(WS_EX_TOOLWINDOW Or WS_EX_TOPMOST, StrPtr(TOOLTIPS_CLASS), 0&, lWinStyle, CW_USEDEFAULT, CW_USEDEFAULT, CW_USEDEFAULT, CW_USEDEFAULT, 0&, 0&, App.hInstance, 0&)
    '
    ' Setup our tooltip info structure.
    ti.lFlags = TTF_SUBCLASS Or TTF_IDISHWND
    If bCentered Then ti.lFlags = ti.lFlags Or TTF_CENTERTIP
    ' Set the hwnd prop to our parent control's hwnd.
    ti.hWnd = ParentHwnd
    ti.lId = ParentHwnd
    ti.hInstance = App.hInstance
    ti.lpStr = TipText
    ti.lSize = LenB(ti)
    ' Set the tooltip structure
    SendMessageLongA hwndTT, TTM_ADDTOOLW, 0&, VarPtr(ti)
    SendMessageLongA hwndTT, TTM_UPDATETIPTEXTW, 0&, VarPtr(ti)
    '
    ' Colors.
    If lForeColor <> -1& Then SendMessageA hwndTT, TTM_SETTIPTEXTCOLOR, lForeColor, 0&
    If lBackColor <> -1& Then SendMessageA hwndTT, TTM_SETTIPBKCOLOR, lBackColor, 0&
    '
    ' Title or icon.
    If uIcon <> TTNoIcon Or sTitle <> vbNullString Then SendMessageLongA hwndTT, TTM_SETTITLEW, CLng(uIcon), StrPtr(sTitle)
    '
    SendMessageLongA hwndTT, TTM_SETDELAYTIME, TTDT_AUTOPOP, lVisibleTime
    SendMessageLongA hwndTT, TTM_SETDELAYTIME, TTDT_INITIAL, lDelayTime
End Sub

Private Sub DestroyToolTip()
    ' It's not a bad idea to put this in the Form_Unload event just to make sure.
    If hwndTT <> 0& Then DestroyWindow hwndTT
    hwndTT = 0&
End Sub

Private Sub FormatTooltipText(TipText As String, lLen As Long)
    Dim s       As String
    Dim ss()    As String
    Dim i       As Long
    Dim j       As Long
    '
    ' Make sure we need to do anything.
    If lLen = 0& Then Exit Sub
    If lLen < 40& Then lLen = 40&
    If Len(TipText) <= lLen Then Exit Sub
    '
    ss = Split(TipText, vbCrLf)                     ' We split each line separately.
    For j = LBound(ss) To UBound(ss)
        If Len(ss(j)) > lLen Then
            s = vbNullString
            Do
                i = InStrRev(ss(j), " ", lLen + 1&)
                If i = 0& Then
                    s = s & Left$(ss(j), lLen) & vbCrLf ' Build "s" and trim from TipText.
                    ss(j) = Mid$(ss(j), lLen + 1&)
                Else
                    s = s & Left$(ss(j), i - 1&) & vbCrLf ' Build "s" and trim from TipText.
                    ss(j) = Mid$(ss(j), i + 1&)
                End If
                If Len(ss(j)) <= lLen Then
                    ss(j) = s & ss(j) ' Place "s" back into ss(j) and get out.
                    Exit Do
                End If
            Loop
        End If
    Next
    TipText = Join(ss, vbCrLf)
End Sub

Enjoy,
Elroy

[Schmidt]

I don’t understand why going to use all the API calls when there is a HitTest method.

Yep, a tendency to "choose the more complicated code over the easier one" is certainly detectable in the forum...
(along the lines of: "it can't be any good, if there's not a ton of APIs, SubClassing - and preferrably 2 or 3 thunks in it")

@the OP... all what's needed in your TreeView-MouseMove was (using only "on-board-stuff"):

Private Sub Tvw_MouseMove(Button As Integer, Shift As Integer, x As Single, y As Single)
  Dim N As Node
  Set N = Tvw.HitTest(x, y)
   If N Is Nothing Then Tvw.ToolTipText = "Default" Else Tvw.ToolTipText = N.Text
End Sub

Olaf

[yereverluvinuncleber]

Thanks for all that helped, I now have tooltips on my treeview that give the user information on the folders represented in the treeview.

[Krool]

Just use TVN_GETINFOTIP.

[ChrisE]

there is also the .Tag
one could use for Tooltip

[fafalone]

If your TreeView is subclassed you can have it displayed automatically by responding to TVN_GETINFOTIP



(Note you'll want to use TVN_GETINFOTIPA if you're not using a TV designed around Unicode, you won't even receive W messages without responding to WM_NOTIFYFORMAT on creation. Also, you'll need your own system of looking up the item from its hItem)

[yereverluvinuncleber]

Fafalone, could you please post a copy of your code? I have dispensed with the comct32 OCX method of generating the treeview and I am having difficulties reviving the tooltips on my sub-classed method of generating a treeview. Just seeing some code where it is achieved might help me.

[fafalone]

I did post the code... where's the problem; receiving the message or handling it? Only thing the code in that post didn't cover is the different handling if you did switch to ANSI instead of Unicode.

In any case the project pictured is here.


Edit: Here's a more complete and simplified outline:

Public Function GetTVItemlParam(hwndTV As Long, hItem As Long) As Long
  Dim tvi As TVITEM
  
  tvi.hItem = hItem
  tvi.Mask = TVIF_PARAM
  
  If TreeView_GetItem(hwndTV, tvi) Then
    GetTVItemlParam = tvi.lParam
  End If

End Function
Private Function TreeView_GetItem(hWnd As Long, pItem As TVITEM) As Boolean
    TreeView_GetItem = SendMessage(hWnd, TVM_GETITEM, 0, pItem)
End Function


Public Function Subclass2(hWnd As Long, lpfn As Long, Optional uId As Long = 0&, Optional dwRefData As Long = 0&) As Boolean
If uId = 0 Then uId = hWnd
    Subclass2 = SetWindowSubclass(hWnd, lpfn, uId, dwRefData):      Debug.Assert Subclass2
End Function

Public Function UnSubclass2(hWnd As Long, ByVal lpfn As Long, pid As Long) As Boolean
    UnSubclass2 = RemoveWindowSubclass(hWnd, lpfn, pid)
End Function

Public Function TVWndProc(ByVal hWnd As Long, ByVal uMsg As Long, ByVal wParam As Long, ByVal lParam As Long, ByVal uIdSubclass As Long, ByVal dwRefData As Long) As Long
Select Case uMsg
        Case WM_NOTIFYFORMAT
            TVWndProc = NFR_UNICODE
            Exit Function

        Case WM_NOTIFY
            Dim dwRtn As Long
            Dim nmh As NMHDR
            CopyMemory nmh, ByVal lParam, LenB(nmh)
            Select Case nmh.Code
                Case TVN_GETINFOTIPW
                    Dim nmtvgit As NMTVGETINFOTIP
                    Dim sInfoTip As String
                    CopyMemory nmtvgit, ByVal lParam, LenB(nmtvgit)
                    With nmtvgit
                    If .hItem > 0 And .pszText <> 0 Then
                        Dim nItem As Long
                        nItem = GetTVItemlParam(hwndTreeView, .hItem)
                        
                        'Now you have the index of your item in the set of TV items
                        'sInfoTip = LookupTipForItem
                        
                        If Not sInfoTip = vbNullString Then
                            sInfoTip = Left$(sInfoTip, .cchTextMax - 1) & vbNullChar
                            CopyMemory ByVal .pszText, ByVal StrPtr(sInfoTip), LenB(sInfoTip)
                        Else
                            CopyMemory ByVal .pszText, 0&, 4&
                        End If
                    End If
            End Select
            
        Case WM_DESTROY
            Call UnSubclass2(hWnd, PtrTVWndProc(), uIdSubclass)
End Select
TVWndProc = DefSubclassProc(hWnd, uMsg, wParam, lParam)
End Function
Public Function PtrTVWndProc() As Long
PtrTVWndProc = FARPROC(AddressOf TVWndProc)
End Function

You would store your items in a structure like

Public Type TvwItem
    sItem As String
    sTip As String
        
End Type
Public TvItemSet() As TvwItem

And set the lParam to the index when you add it, so you can look up the tip by index.
tVI.Mask = TVIF_PARAM 'Or TVIF_whateverothers
tVI.lParam = TvItemSet(ItemYoureAdding)

[georgekar]

As I post here
https://www.vbforums.com/showthread....=1#post5499670
in CreateToolTip need this line to set wrapping in the Tooltip (so the height of Tooltip automatic calculated)

SendMessage hwndTT, TTM_SETMAXTIPWIDTH, 0&, 0

We add this after

    SendMessageLongA hwndTT, TTM_ADDTOOLW, 0&, VarPtr(ti)
    SendMessageLongA hwndTT, TTM_UPDATETIPTEXTW, 0&, VarPtr(ti)