Public Class MyTreeView
  Inherits Control

  Protected Overrides ReadOnly Property CreateParams() As CreateParams
    Get
      Dim cp As CreateParams = MyBase.CreateParams
      cp.ClassName = WC_TREEVIEW
      cp.Style = WS_VISIBLE Or WS_CHILD Or WS_BORDER
      Return cp
    End Get
  End Property
...

Public Class MyTreeView
  Inherits Control

  Private m_hwndTV As IntPtr ' handle to tree-view control 

  Public Enum eBorderStyle
    None
    FixedSingle
    Fixed3D
  End Enum

  'local variable(s) to hold property value(s)
  Private m_borderStyle As eBorderStyle
  Private m_Scrollable As Boolean
  Private m_HideSelection As Boolean
  Private m_ShowLines As Boolean
  Private m_ShowPlusMinus As Boolean
  Private m_ShowRootLines As Boolean
  Private m_HotTracking As Boolean
  Private m_FullRowSelect As Boolean

  Private m_ExplorerStyle As Boolean

  Private m_FadeInOutExpandos As Boolean
  Private m_AutoHScroll As Boolean
  Private m_DoubleBuffer As Boolean
  Private m_RichTooltips As Boolean

  Private m_ItemHeight As Integer

  Public Sub New()
    m_borderStyle = eBorderStyle.Fixed3D
    m_Scrollable = True
    m_HideSelection = False
    m_ShowLines = False
    m_ShowPlusMinus = True
    m_ShowRootLines = False
    m_HotTracking = False
    m_FullRowSelect = False

    m_ExplorerStyle = False

    m_FadeInOutExpandos = False
    m_AutoHScroll = False
    m_DoubleBuffer = False
    m_RichTooltips = False

    m_ItemHeight = 16

  End Sub

  Public Sub Create()
    If m_hwndTV <> IntPtr.Zero Then Exit Sub
    Dim rcClient As RECT  ' dimensions of client area 

    ' Get the dimensions of the parent window's client area, and create 
    ' the tree-view control. 
    GetClientRect(Handle, rcClient)

    Dim tvStyle As Integer = WS_VISIBLE Or WS_CHILD
    If m_borderStyle = eBorderStyle.FixedSingle Then tvStyle = tvStyle Or WS_BORDER
    If m_Scrollable = False Then tvStyle = tvStyle Or TVS_NOHSCROLL
    If m_HideSelection = False Then tvStyle = tvStyle Or TVS_SHOWSELALWAYS
    If m_ShowLines Then tvStyle = tvStyle Or TVS_HASLINES
    If m_ShowPlusMinus Then tvStyle = tvStyle Or TVS_HASBUTTONS
    If m_ShowRootLines Then tvStyle = tvStyle Or TVS_LINESATROOT
    If m_HotTracking Then tvStyle = tvStyle Or TVS_TRACKSELECT
    If m_FullRowSelect Then tvStyle = tvStyle Or TVS_FULLROWSELECT

    Dim ExStyle As Integer = 0
    If m_borderStyle = eBorderStyle.Fixed3D Then ExStyle = ExStyle Or WS_EX_CLIENTEDGE

    m_hwndTV = CreateWindowEx(ExStyle,
                            WC_TREEVIEW,
                            vbNullString,
                            tvStyle,
                            0,
                            0,
                            rcClient.Right,
                            rcClient.Bottom,
                            Handle,
                            IntPtr.Zero,
                            System.Runtime.InteropServices.Marshal.GetHINSTANCE _
                            (System.Reflection.Assembly.GetExecutingAssembly.GetModules()(0)), _
                            Nothing) 'Or TVS_HASLINES Or WS_BORDER Or WS_TABSTOP

    If m_ItemHeight <> 16 Then SendMessage(m_hwndTV, TVM_SETITEMHEIGHT, m_ItemHeight, 0)

    If m_ExplorerStyle Then _
     SetWindowTheme(m_hwndTV, "explorer", vbNullString) 'стиль для Висты и выше

    If m_FadeInOutExpandos Or m_AutoHScroll Or m_DoubleBuffer Or m_RichTooltips Then 'надо установить доп. стили
      Dim tvExStyle As Integer = SendMessage(m_hwndTV, TVM_GETEXTENDEDSTYLE, 0, 0)
      If m_FadeInOutExpandos Then tvExStyle = tvExStyle Or TVS_EX_FADEINOUTEXPANDOS
      If m_AutoHScroll Then tvExStyle = tvExStyle Or TVS_EX_AUTOHSCROLL
      If m_DoubleBuffer Then tvExStyle = tvExStyle Or TVS_EX_DOUBLEBUFFER
      If m_RichTooltips Then tvExStyle = tvExStyle Or TVS_EX_RICHTOOLTIP
      Call SendMessage(m_hwndTV, TVM_SETEXTENDEDSTYLE, 0, tvExStyle)
    End If
  End Sub

  Public Sub Destroy()
    If m_hwndTV <> IntPtr.Zero Then
      DestroyWindow(m_hwndTV)
      m_hwndTV = IntPtr.Zero
    End If
  End Sub

  Public Sub SetImageList(ByVal hIml As IntPtr)
    SendMessage(m_hwndTV, TVM_SETIMAGELIST, TVSIL_NORMAL, hIml)
  End Sub

  Public Function AddItem(ByVal hParent As IntPtr, ByVal hInsertAfter As IntPtr, _
   ByVal strKey As String, ByVal strText As String, ByVal iImage As Integer, ByVal iSelectedImage As Integer) As IntPtr
    Dim tvi As New TVITEM
    With tvi
      .mask = TVIF_TEXT Or TVIF_IMAGE Or TVIF_SELECTEDIMAGE
      .pszText = strText
      .iImage = iImage
      .iSelectedImage = iSelectedImage
    End With
    Dim tvins As New TVINSERTSTRUCT
    With tvins
      .hParent = hParent
      .hInsertAfter = hInsertAfter
      .item = tvi
    End With
    Return SendMessage_TVINSERTSTRUCT(m_hwndTV, TVM_INSERTITEM, 0, tvins)
  End Function

  Public Sub New()
    MyBase.New()

    SetStyle(ControlStyles.UserPaint, False)
    SetStyle(ControlStyles.StandardClick, False)
    SetStyle(ControlStyles.UseTextForAccessibility, False)
  End Sub

Private Function WmShowToolTip(ByRef m As Message) As Boolean
	Dim ptr As __Pointer(Of NativeMethods.NMHDR) = CType((CType(m.LParam, __Pointer(Of Void))), __Pointer(Of NativeMethods.NMHDR))
	Dim hwndFrom As IntPtr = ptr.Dereference().hwndFrom
	Dim tV_HITTESTINFO As NativeMethods.TV_HITTESTINFO = New NativeMethods.TV_HITTESTINFO()
	Dim p As Point = Cursor.Position
	p = MyBase.PointToClientInternal(p)
	tV_HITTESTINFO.pt_x = p.X
	tV_HITTESTINFO.pt_y = p.Y
	Dim intPtr As IntPtr = UnsafeNativeMethods.SendMessage(New HandleRef(Me, MyBase.Handle), 4369, 0, tV_HITTESTINFO)
	If intPtr <> IntPtr.Zero AndAlso (tV_HITTESTINFO.flags And 70) <> 0 Then
		Dim treeNode As TreeNode = Me.NodeFromHandle(intPtr)
		If treeNode IsNot Nothing AndAlso Not Me.ShowNodeToolTips Then
			Dim bounds As Rectangle = treeNode.Bounds
			bounds.Location = MyBase.PointToScreen(bounds.Location)
			UnsafeNativeMethods.SendMessage(New HandleRef(Me, hwndFrom), 1055, 1, bounds)
			SafeNativeMethods.SetWindowPos(New HandleRef(Me, hwndFrom), NativeMethods.HWND_TOPMOST, bounds.Left, bounds.Top, 0, 0, 21)
			Return True
		End If
	End If
	Return False
End Function

Public Class TreeViewMy
  Inherits TreeView

  Protected Overrides Sub WndProc(ByRef m As Message)
    'Debug.Print(m.ToString)

    Static hwndTooltip As IntPtr 'Tooltip handle
    Static TooltipTextColor As Integer ' цвет текста Tooltip
    Static hNode As IntPtr 'TV Node handle
    Select Case m.Msg
      Case WM_NOTIFY
        If sys_WinVista And App_ThemesEnabled() Then
          Dim nmhdr As NMHDR = CType(Marshal.PtrToStructure(m.LParam, GetType(NMHDR)), NMHDR)
          Select Case nmhdr.code
            Case TTN_SHOW
              'Debug.Print("TTN_SHOW")
              hwndTooltip = nmhdr.hwndFrom
              Dim pos As POINTAPI
              pos.x = Cursor.Position.X
              pos.y = Cursor.Position.Y
              MapWindowPoints(IntPtr.Zero, Handle, pos, 1) 'приведение к координатам TreeView
              'Debug.Print(pos.x & " " & pos.y)

              'Вычисление итема (узла дерева)
              Dim tvhip As TVHITTESTINFO = New TVHITTESTINFO
              tvhip.pt = pos
              hNode = SendMessage_TVHITTESTINFO(Handle, TVM_HITTEST, 0, tvhip)
              'Debug.Print(hNode.ToString)
              If hNode <> IntPtr.Zero AndAlso ((tvhip.flags And TVHT_ONITEM) <> 0) Then
                'Вычисление границ итема (от начала текста)
                Dim rcNode As RECT
                If Is64bitProcess() Then
                  Dim rcNodeXX As RECT_XX
                  rcNodeXX.LeftX64 = hNode.ToInt64
                  rcNode.Left = rcNodeXX.Left : rcNode.Top = rcNodeXX.Top
                Else
                  rcNode.Left = hNode.ToInt32
                End If
                SendMessage_RECT(Handle, TVM_GETITEMRECT, True, rcNode)
                MapWindowPoints(Handle, IntPtr.Zero, rcNode, 2) 'приведение к координатам экрана
                'Debug.Print(rcNode.Left & " " & rcNode.Right & " " & rcNode.Top & " " & rcNode.Bottom)

                'изменение положения и размеров Tooltip
                Dim rcTooltip As RECT
                GetWindowRect(hwndTooltip, rcTooltip)
                'экспериментально: сдвигаем на 22px влево (2+16+4), увеличиваем ширину на 16px, высоту подгоняем под высоту Node
                SetWindowPos(hwndTooltip, IntPtr.Zero, rcNode.Left - 22, rcNode.Top, rcTooltip.Right - rcTooltip.Left + 16, rcNode.Bottom - rcNode.Top, SWP_NOACTIVATE Or SWP_NOZORDER)
                'насчет этой строчки, не уверен нужна ли она вообще
                SetWindowPos(hwndTooltip, HWND_TOPMOST, rcNode.Left - 22, rcNode.Top, 0, 0, SWP_NOACTIVATE Or SWP_NOSIZE Or SWP_NOZORDER)

                m.Result = 1 ' чтобы отменить "дефолтное" позиционирование
                Exit Sub 'чтобы отменить позиционирование из Treeview.cs
              End If
            Case NM_CUSTOMDRAW
              If nmhdr.hwndFrom = hwndTooltip Then
                'Debug.Print("NM_CUSTOMDRAW")
                Dim ttcd As NMTTCUSTOMDRAW = CType(Marshal.PtrToStructure(m.LParam, GetType(NMTTCUSTOMDRAW)), NMTTCUSTOMDRAW)
                Select Case ttcd.nmcd.dwDrawStage
                  ' ====================================================
                  'https://stevenengelhardt.com/2007/08/29/custom-drawn-win32-tooltips/
                  Case CD_DrawStage.CDDS_PREPAINT
                    'Debug.Print("CDDS_PREPAINT")
                    '!!!Workaround, придраться конечно можно но в целом текст замазывается даже при стилях
                    'с учетом того что на том же месте пишем новый текст, абсолютно незаметно
                    'убирать текст через TTM_UPDATETIPTEXT(напр. забить пробелом) из WndProc нельзя, 
                    ' т.к. это вызовет цепную реакцию из TTN_SHOW
                    'tooltip control will continue to draw the static text even if we are using custom draw.
                    'To get around this problem, we’ll have the tooltip control draw the text 
                    'in the same color as the background, effectively making it invisible
                    Dim clrBg As Integer = SendMessage(hwndTooltip, TTM_GETTIPBKCOLOR, 0, 0)
                    TooltipTextColor = SendMessage(hwndTooltip, TTM_GETTIPTEXTCOLOR, 0, 0)
                    SetTextColor(ttcd.nmcd.hdc, clrBg)
                    SetBkColor(ttcd.nmcd.hdc, clrBg)
                    m.Result = CD_ReturnFlags.CDRF_NOTIFYPOSTPAINT 'когда система дорисует пустой,пусть сообщит
                    Exit Sub
                  Case CD_DrawStage.CDDS_POSTPAINT 'теперь можно тупо рисовать содержимое
                    'Debug.Print("CDDS_POSTPAINT")
                    'вычисляем текст и номер картинки в ImageList для нашего Node
                    Dim tvi As New TVITEM
                    With tvi
                      .hItem = hNode
                      .mask = TVIF_TEXT Or TVIF_IMAGE
                      .pszText = Space(MAX_PATH)
                      .cchTextMax = MAX_PATH
                    End With
                    SendMessage_TVITEM(Handle, TVM_GETITEM, 0, tvi)

                    'Накладываем картинку на Tooltip (по горизонтали отступ 3px, по вертикали по центру итема)
                    Dim hIcon As IntPtr = CType(Me.ImageList.Images(tvi.iImage), Bitmap).GetHicon
                    DrawIconEx(ttcd.nmcd.hdc, _
                     3, _
                     (Me.ItemHeight - 16) / 2, _
                     hIcon, 16, 16, _
                     0, 0, DI_NORMAL)
                    DestroyIcon(hIcon)

                    'Рисуем текст Tooltip (с восстановлением цвета текста)
                    '(по горизонтали отступ 24px, по верт. по центру итема, по кр.мере для Segoe UI 9 так корректно при любой высоте итема)
                    SetTextColor(ttcd.nmcd.hdc, TooltipTextColor)
                    TextOut(ttcd.nmcd.hdc, 24, (Me.ItemHeight - 16) / 2, tvi.pszText, Strings.Len(tvi.pszText))
                  Case Else
                End Select
              End If
          End Select
        End If
    End Select

    MyBase.WndProc(m)

  End Sub