dcsimg
Results 1 to 19 of 19

Thread: VB6 - QUESTION - Is it possible to add tooltiptext to individual items in a treeview?

  1. #1

    Thread Starter
    Addicted Member
    Join Date
    Feb 2014
    Posts
    185

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

    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?

  2. #2
    PowerPoster
    Join Date
    Feb 2006
    Posts
    20,323

    Re: VB6 - QUESTION - Is it possible to add tooltiptext to individual items in a treev

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

  3. #3

    Thread Starter
    Addicted Member
    Join Date
    Feb 2014
    Posts
    185

    Re: VB6 - QUESTION - Is it possible to add tooltiptext to individual items in a treev

    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.

  4. #4
    PowerPoster Arnoutdv's Avatar
    Join Date
    Oct 2013
    Posts
    3,512

    Re: VB6 - QUESTION - Is it possible to add tooltiptext to individual items in a treev

    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

  5. #5
    PowerPoster Elroy's Avatar
    Join Date
    Jun 2014
    Location
    Near Nashville TN
    Posts
    5,627

    Re: VB6 - QUESTION - Is it possible to add tooltiptext to individual items in a treev



    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.
    Attached Files Attached Files
    Any software I post in these forums written by me is provided “AS IS” without warranty of any kind, expressed or implied, and permission is hereby granted, free of charge and without restriction, to any person obtaining a copy. Please understand that I’ve been programming since the mid-1970s and still have some of that code. My contemporary VB6 project is approaching 1,000 modules. In addition, I have a “VB6 random code folder” that is overflowing. I’ve been at this long enough to truly not know with absolute certainty from whence every single line of my code has come, with much of it coming from programmers under my employ who signed intellectual property transfers. I have not deliberately attempted to remove any licenses and/or attributions from any software. If someone finds that I have inadvertently done so, I sincerely apologize, and, upon notice and reasonable proof, will re-attach those licenses and/or attributions. To all, peace and happiness.

  6. #6

    Thread Starter
    Addicted Member
    Join Date
    Feb 2014
    Posts
    185

    Re: VB6 - QUESTION - Is it possible to add tooltiptext to individual items in a treev

    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.

  7. #7

    Thread Starter
    Addicted Member
    Join Date
    Feb 2014
    Posts
    185

    Re: VB6 - QUESTION - Is it possible to add tooltiptext to individual items in a treev

    I do love VB6.

  8. #8
    PowerPoster Elroy's Avatar
    Join Date
    Jun 2014
    Location
    Near Nashville TN
    Posts
    5,627

    Re: VB6 - QUESTION - Is it possible to add tooltiptext to individual items in a treev

    Quote Originally Posted by yereverluvinuncleber View Post
    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.
    Any software I post in these forums written by me is provided “AS IS” without warranty of any kind, expressed or implied, and permission is hereby granted, free of charge and without restriction, to any person obtaining a copy. Please understand that I’ve been programming since the mid-1970s and still have some of that code. My contemporary VB6 project is approaching 1,000 modules. In addition, I have a “VB6 random code folder” that is overflowing. I’ve been at this long enough to truly not know with absolute certainty from whence every single line of my code has come, with much of it coming from programmers under my employ who signed intellectual property transfers. I have not deliberately attempted to remove any licenses and/or attributions from any software. If someone finds that I have inadvertently done so, I sincerely apologize, and, upon notice and reasonable proof, will re-attach those licenses and/or attributions. To all, peace and happiness.

  9. #9
    PowerPoster Elroy's Avatar
    Join Date
    Jun 2014
    Location
    Near Nashville TN
    Posts
    5,627

    Re: VB6 - QUESTION - Is it possible to add tooltiptext to individual items in a treev

    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.

    Code:
    
    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
    Last edited by Elroy; Jun 22nd, 2019 at 11:54 AM.
    Any software I post in these forums written by me is provided “AS IS” without warranty of any kind, expressed or implied, and permission is hereby granted, free of charge and without restriction, to any person obtaining a copy. Please understand that I’ve been programming since the mid-1970s and still have some of that code. My contemporary VB6 project is approaching 1,000 modules. In addition, I have a “VB6 random code folder” that is overflowing. I’ve been at this long enough to truly not know with absolute certainty from whence every single line of my code has come, with much of it coming from programmers under my employ who signed intellectual property transfers. I have not deliberately attempted to remove any licenses and/or attributions from any software. If someone finds that I have inadvertently done so, I sincerely apologize, and, upon notice and reasonable proof, will re-attach those licenses and/or attributions. To all, peace and happiness.

  10. #10

    Thread Starter
    Addicted Member
    Join Date
    Feb 2014
    Posts
    185

    Re: VB6 - QUESTION - Is it possible to add tooltiptext to individual items in a treev

    WoW!

  11. #11
    PowerPoster Arnoutdv's Avatar
    Join Date
    Oct 2013
    Posts
    3,512

    Re: VB6 - QUESTION - Is it possible to add tooltiptext to individual items in a treev

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

  12. #12
    Super Moderator Shaggy Hiker's Avatar
    Join Date
    Aug 2002
    Location
    Idaho
    Posts
    33,932

    Re: VB6 - QUESTION - Is it possible to add tooltiptext to individual items in a treev

    Quote Originally Posted by yereverluvinuncleber View Post
    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.
    My usual boring signature: Nothing

  13. #13
    Lively Member jj2007's Avatar
    Join Date
    Dec 2015
    Posts
    110

    Re: VB6 - QUESTION - Is it possible to add tooltiptext to individual items in a treev

    Check the TTN_NEEDTEXT notification.

  14. #14
    PowerPoster Elroy's Avatar
    Join Date
    Jun 2014
    Location
    Near Nashville TN
    Posts
    5,627

    Re: VB6 - QUESTION - Is it possible to add tooltiptext to individual items in a treev

    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.

    Code:
    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
    Any software I post in these forums written by me is provided “AS IS” without warranty of any kind, expressed or implied, and permission is hereby granted, free of charge and without restriction, to any person obtaining a copy. Please understand that I’ve been programming since the mid-1970s and still have some of that code. My contemporary VB6 project is approaching 1,000 modules. In addition, I have a “VB6 random code folder” that is overflowing. I’ve been at this long enough to truly not know with absolute certainty from whence every single line of my code has come, with much of it coming from programmers under my employ who signed intellectual property transfers. I have not deliberately attempted to remove any licenses and/or attributions from any software. If someone finds that I have inadvertently done so, I sincerely apologize, and, upon notice and reasonable proof, will re-attach those licenses and/or attributions. To all, peace and happiness.

  15. #15
    PowerPoster
    Join Date
    Jun 2013
    Posts
    4,329

    Re: VB6 - QUESTION - Is it possible to add tooltiptext to individual items in a treev

    Quote Originally Posted by Arnoutdv View Post
    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"):
    Code:
    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

  16. #16

    Thread Starter
    Addicted Member
    Join Date
    Feb 2014
    Posts
    185

    Re: VB6 - QUESTION - Is it possible to add tooltiptext to individual items in a treev

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

  17. #17
    Frenzied Member
    Join Date
    Jun 2012
    Posts
    1,266

    Re: VB6 - QUESTION - Is it possible to add tooltiptext to individual items in a treev

    Just use TVN_GETINFOTIP.

  18. #18
    Frenzied Member ChrisE's Avatar
    Join Date
    Jun 2017
    Location
    Frankfurt
    Posts
    1,969

    Re: VB6 - QUESTION - Is it possible to add tooltiptext to individual items in a treev

    there is also the .Tag
    one could use for Tooltip
    to hunt a species to extinction is not logical !
    since 2010 the number of Tigers are rising again in 2016 - 3900 were counted. with Baby Callas it's 3901, my wife and I had 2-3 months the privilege of raising a Baby Tiger.

  19. #19
    PowerPoster
    Join Date
    Jul 2010
    Location
    NYC
    Posts
    2,262

    Re: VB6 - QUESTION - Is it possible to add tooltiptext to individual items in a treev

    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)

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •  



Featured


Click Here to Expand Forum to Full Width