Imports System.Runtime.InteropServices

Public Class cTooltip

  'local variable(s) to hold property value(s)
  Private mvarTipText As String
  Private mvarVisibleTime As Integer
  Private mvarDelayTime As Integer

  'private data
  Private m_lTTHwnd As IntPtr ' hwnd of the tooltip
  Private m_lParentHwnd As IntPtr ' hwnd of the window the tooltip attached to
  Private ti As TOOLINFO

  Public Sub New()
    mvarDelayTime = 500
    mvarVisibleTime = 5000
  End Sub

  Protected Overrides Sub Finalize()
    Destroy()
  End Sub

  Public Sub Create(ByVal ParentHwnd As IntPtr)

    If m_lTTHwnd <> IntPtr.Zero Then DestroyWindow(m_lTTHwnd)

    m_lParentHwnd = ParentHwnd

    Dim lWinStyle As Integer = TTS_ALWAYSTIP Or TTS_NOPREFIX

    m_lTTHwnd = CreateWindowEx(0, _
     TOOLTIPS_CLASSW, _
     vbNullString, _
     lWinStyle, _
     CW_USEDEFAULT, _
     CW_USEDEFAULT, _
     CW_USEDEFAULT, _
     CW_USEDEFAULT, _
     0, _
     0, _
     System.Runtime.InteropServices.Marshal.GetHINSTANCE _
      (System.Reflection.Assembly.GetExecutingAssembly.GetModules()(0)), _
     Nothing)

    'now set our tooltip info structure
    With ti
      .uFlags = TTF_SUBCLASS Or TTF_IDISHWND

      'set the hwnd prop to our parent control's hwnd
      .hwnd = m_lParentHwnd
      .lId = m_lParentHwnd
      .hinst = System.Runtime.InteropServices.Marshal.GetHINSTANCE _
       (System.Reflection.Assembly.GetExecutingAssembly.GetModules()(0))
      '.lpszText = ALREADY SET
      '.rect = lpRect
      .cbSize = Marshal.SizeOf(ti)
    End With

    'add the tooltip structure
    SendMessage_TOOLINFO(m_lTTHwnd, TTM_ADDTOOL, 0, ti)

    SendMessage(m_lTTHwnd, TTM_SETDELAYTIME, TTDT_AUTOPOP, mvarVisibleTime)
    SendMessage(m_lTTHwnd, TTM_SETDELAYTIME, TTDT_INITIAL, mvarDelayTime)
  End Sub

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

  Public Property TipText() As String
    Set(ByVal vData As String)
      mvarTipText = vData
      ti.lpszText = vData
      If m_lTTHwnd <> IntPtr.Zero Then
        SendMessage_TOOLINFO(m_lTTHwnd, TTM_UPDATETIPTEXT, 0, ti)
      End If
    End Set
    Get
      Return mvarTipText
    End Get
  End Property

  Public Property VisibleTime() As Integer
    Set(ByVal lData As Integer)
      mvarVisibleTime = lData
    End Set
    Get
      Return mvarVisibleTime
    End Get
  End Property

  Public Property DelayTime() As Integer
    Set(ByVal lData As Integer)
      mvarDelayTime = lData
    End Set
    Get
      Return mvarDelayTime
    End Get
  End Property

End Class

Imports System.Runtime.InteropServices

Module m_Tooltip

  Public Const TOOLTIPS_CLASSW = "tooltips_class32"

  'Tooltip Structures

  'Custom Draw
  <StructLayout(LayoutKind.Sequential)>
  Public Structure NMTTCUSTOMDRAW

    ' NMCUSTOMDRAW structure that contains general Custom Draw information.
    Dim nmcd As NMCUSTOMDRAW

    ' UINT value specifying how ToolTip text will be formatted when it is displayed.
    ' This value is passed to the DrawText function internally. All values for the
    ' uFormat parameter of DrawText are valid.
    Dim uDrawFlags As Integer

  End Structure

  'uFlags Flags that control the tooltip display
  Public Const TTF_IDISHWND = &H1
  Public Const TTF_CENTERTIP = &H2
  Public Const TTF_SUBCLASS = &H10
  Public Const TTF_TRACK = &H20
  Public Const TTF_ABSOLUTE = &H80
  Public Const TTF_TRANSPARENT = &H100

  <StructLayout(LayoutKind.Sequential, CharSet:=CharSet.Unicode)>
  Public Structure TOOLINFO
    Dim cbSize As Integer
    Dim uFlags As Integer
    Dim hwnd As IntPtr
    Dim lId As IntPtr
    Dim rect As RECT
    Dim hinst As IntPtr
    Dim lpszText As String
    Dim lParam As Integer
  End Structure

  'TTM_SETDELAYTIME wParam
  Public Const TTDT_AUTOPOP = 2
  Public Const TTDT_INITIAL = 3

  'Tooltip Control Messages
  Private Const WM_USER = &H400
  Public Const TTM_SETDELAYTIME = (WM_USER + 3)
  Public Const TTM_ADDTOOLA = (WM_USER + 4)
  Public Const TTM_ADDTOOLW = (WM_USER + 50)
  Public Const TTM_ADDTOOL = TTM_ADDTOOLW
  Public Const TTM_UPDATETIPTEXTA = (WM_USER + 12)
  Public Const TTM_UPDATETIPTEXTW = (WM_USER + 57)
  Public Const TTM_UPDATETIPTEXT = TTM_UPDATETIPTEXTW
  Public Const TTM_TRACKACTIVATE = WM_USER + 17
  Public Const TTM_TRACKPOSITION = WM_USER + 18
  Public Const TTM_GETTIPBKCOLOR = (WM_USER + 22)
  Public Const TTM_GETTIPTEXTCOLOR = (WM_USER + 23)
  Public Const TTM_ADJUSTRECT = (WM_USER + 31)

  'Tooltip Control Notifications
  Public Const TTN_FIRST = (-520)
  Public Const TTN_GETDISPINFO = (TTN_FIRST - 0)
  Public Const TTN_SHOW = (TTN_FIRST - 1)
  Public Const TTN_POP = (TTN_FIRST - 2)

  'Tooltip Styles
  Public Const TTS_ALWAYSTIP = &H1
  Public Const TTS_NOPREFIX = &H2
  Public Const TTS_NOANIMATE = &H10
  Public Const TTS_BALLOON = &H40
  Public Const TTS_USEVISUALSTYLE = &H100

  Public Declare Unicode Function SendMessage_TOOLINFO Lib "user32" Alias "SendMessageW" _
   (ByVal hwnd As IntPtr, ByVal wMsg As Integer, ByVal wParam As Integer, ByRef lParam As TOOLINFO) As Integer

End Module

  Public Const CW_USEDEFAULT = &H80000000

  Public Declare Unicode Function CreateWindowEx Lib "user32" Alias "CreateWindowExW" _
   (ByVal dwExStyle As Integer, ByVal lpClassName As String, ByVal lpWindowName As String, _
   ByVal dwStyle As Integer, ByVal x As Integer, ByVal y As Integer, ByVal nWidth As Integer, _
   ByVal nHeight As Integer, ByVal hwndParent As IntPtr, ByVal hMenu As IntPtr, _
   ByVal hInstance As IntPtr, ByRef lpParam As Object) As IntPtr
  Public Declare Function DestroyWindow Lib "user32" (ByVal hwnd As IntPtr) As Boolean
  Public Declare Unicode Function SendMessage Lib "user32" Alias "SendMessageW" _
   (ByVal hwnd As IntPtr, ByVal wMsg As Integer, ByVal wParam As Integer, ByVal lParam As IntPtr) As Integer