Private hwndTip As Long
Private Const WS_EX_TOPMOST As Long = &H8&
Private Const CW_USEDEFAULT As Long = &H80000000

Private Const TOOLTIPS_CLASSA As String = "tooltips_class32"
Private Const HWND_TOPMOST As Long = -1

Private Const SWP_NOMOVE As Long = &H2
Private Const SWP_NOACTIVATE As Long = &H10
Private Const SWP_NOSIZE As Long = &H1

Private Const WM_USER As Long = &H400
Private Const WS_POPUP As Long = &H80000000

Private Const TTF_IDISHWND As Long = &H1
Private Const TTF_SUBCLASS As Long = &H10

'Indicates that the ToolTip control appears when
'the cursor is on a tool, even if the ToolTip
'control's owner window is inactive. Without this
'style, the ToolTip appears only when the tool's
'owner window is active.
Private Const TTS_ALWAYSTIP As Long = &H1

'Prevents the system from stripping the ampersand
'character from a string. Without this style, the
'system automatically strips ampersand characters.
'This allows an application to use the same string
'as both a menu item and as text in a ToolTip control.
Private Const TTS_NOPREFIX As Long = &H2

'Version 5.80. Disables sliding ToolTip animation
'on Microsoft Windows 98 and Windows 2000 systems.
'This style is ignored on earlier systems.
Private Const TTS_NOANIMATE As Long = &H10

'Version 5.80. Disables fading ToolTip animation on
'Windows 2000 systems. This style is ignored on
'earlier Windows NT systems, and on Windows 95 and
'Windows 98.
Private Const TTS_NOFADE As Long = &H20

'Version 5.80. Indicates that the ToolTip control
'has the appearance of a cartoon "balloon," with
'rounded corners and a stem pointing to the item.
Private Const TTS_BALLOON As Long = &H40

'include a X button in the title area of the
'tooltip or balloon tip
Private Const TTS_CLOSE As Long = &H80

Private Const TTM_ACTIVATE As Long = (WM_USER + 1)
Private Const TTM_ADDTOOL As Long = (WM_USER + 4)
Private Const TTM_UPDATETIPTEXT As Long = (WM_USER + 12)
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_SETTITLE As Long = (WM_USER + 32)  'IE >= 0x0500

Private Type RECT
  Left As Long
  Top As Long
  Right As Long
  Bottom As Long
End Type

Private Type TOOLINFO
  cbSize As Long
  uFlags As Long
  hwnd As Long
  uid As Long
  rc As RECT
  hinst As Long
  lpszText As String
  lParam As Long
End Type

Private Declare Function CreateWindowEx Lib "user32" Alias "CreateWindowExA" _
  (ByVal dwExStyle As Long, _
   ByVal lpClassName As String, _
   ByVal lpWindowName As String, _
   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 Declare Function SetWindowPos Lib "user32" _
  (ByVal hwnd As Long, _
   ByVal hWndInsertAfter As Long, _
   ByVal X As Long, _
   ByVal Y As Long, _
   ByVal cx As Long, _
   ByVal cy As Long, _
   ByVal wFlags As Long) As Long

Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" _
  (ByVal hwnd As Long, _
   ByVal wMsg As Long, _
   ByVal wParam As Long, _
   lParam As Any) As Long

Private Declare Function GetClientRect Lib "user32" _
  (ByVal hwnd As Long, lpRect As RECT) As Long

Private Declare Function InitCommonControls Lib "comctl32" () As Long


Private Sub Form_Load()

   Command1.Caption = "Create ToolTips"
   Command2.Caption = "Change Tip Text Colour"
   Command3.Caption = "Change Tip Back Colour"
   Command4.Caption = "Restrict Width to 100 pixels"
   Command5.Caption = "Set Width to Automatic"
   Command6.Caption = "Add Title to ToolTip"
   Command7.Caption = "Remove Title from ToolTip"
   Command8.Caption = "Change Tip for Text3"
   Command9.Caption = "Destroy ToolTip"
   
   Command1.Enabled = True
   Command2.Enabled = False
   Command3.Enabled = False
   Command4.Enabled = False
   Command5.Enabled = False
   Command6.Enabled = False
   Command7.Enabled = False
   Command8.Enabled = False
   Command9.Enabled = False
   
   Text1.Text = "Mouse over to see animated tip text"
   Text2.Text = "Mouse over to see maxwidth linewrap demo"
   Text3.Text = "Mouse over to see effect of using vbCrLf"   

End Sub


Private Sub Form_Initialize()

Call InitCommonControls

End Sub


Private Sub Form_Unload(Cancel As Integer)
  
  Timer1.Enabled = False
  Call tooltip_destroy(hwndTip)
  
End Sub


Private Sub Command1_Click()

  'create the tooltip host control (window)
   hwndTip = tooltip_create(Me.hwnd, True, False)

   If hwndTip <> 0 Then
   
     'set the back and text colours
     'for the tooltip host control
      tooltip_setbackcolour hwndTip, vbBlue
      tooltip_settextcolour hwndTip, vbWhite
     
     'Tell the tooltip to automatically adjust its
     'size based on the string. A long string may
     'exceed the width of the form or screen. A new
     'line chr (vbcrlf) introduced into the string
     'will cause the text to start on a new line.
      tooltip_setmaxwidth hwndTip, 0
      
     'instruct the tooltip that it can show itself as
     'required, when the mouse passes over the
     'respective control. Call tooltip_deactivate to
     'turn off the tooltip. Note: this command applies
     'to the parent ToolTip window created with CreateWindowEx,
     'thus the command issued here affects all controls
     'using that base ToolTip window to provide control
     'tips based on the TOOLINFO data. If you need the
     'ability to have some tips enabled and some disabled,
     'you can either call tooltip_activate/deactivate in
     'the got/lostfocus events of the controls, or you can
     'create additional ToolTip main windows by calling
     'tool_tip create and a new set of assignments using
     'tooltip_addtool. Note too that if this is done,
     'additional code will be required to track the hwnds
     'of the ToolTip windows created from each call to
     'CreateWindowEx, in order to properly reference the
     'windows in subsequent commands including clean up
     '(DestroyWindow).
      tooltip_activate hwndTip
      
      
     'Attach three TOOLINFO structures to the
     'tooltip control, each associated with
     'a different control on the form. This
     'binds the tooltip to the specified control,
     'resulting in the appropriate tip being
     'displayed when the mouse is over the control.
      tooltip_addtool hwndTip, Text1.hwnd, vbNullString
      tooltip_addtool hwndTip, Text2.hwnd, "And this example is a longer " & _
                                           "Tooltip for Text 2 to show the " & _
                                           "effect of changing the tooltip_setmaxwidth."
      tooltip_addtool hwndTip, Text3.hwnd, "Here's Text 3's Tooltip"
      
      
     'this is not required in production code; it is used
     'to display the effect of calling tooltip_updatetext
     'to change the tooltip text while the tooltip is displayed.
     '(As coded, only the tooltip assigned to Text1 will
     'change; the other two text box tooltips will retain
     'their respective messages.)
      Timer1.Interval = 1200
      Timer1.Enabled = True
   
      Command1.Enabled = False
      Command2.Enabled = True
      Command3.Enabled = True
      Command4.Enabled = True
      Command5.Enabled = True
      Command6.Enabled = True
      Command7.Enabled = True
      Command8.Enabled = True
      Command9.Enabled = True
      
   End If
   
End Sub


Private Sub Command2_Click()

    tooltip_settextcolour hwndTip, vbYellow

End Sub


Private Sub Command3_Click()

   tooltip_setbackcolour hwndTip, vbRed
 
End Sub


Private Sub Command4_Click()

   tooltip_setmaxwidth hwndTip, 100

End Sub


Private Sub Command5_Click()

  'Specify 0 to set to automatic sizing.
  'vbCrLf is recognized as a line feed in the message.
  
  'specify -1 to return to automatic sizing but
  'to also have the control ignore line feed
  'characters (they will appear as blocks in the string.)
  
  'to test this difference, run the demo, hit Command3
  'to assign a long string with linefeeds to the
  'tooltip associated with Text3. The tip will
  'display as a multi-line tooltip. Pause the
  'demo, change 0 below to -1, resume the app
  'and hit this button again. Now the tooltip
  'will display all on one line but with blocks
  'representing the linefeeds.
   tooltip_setmaxwidth hwndTip, 0
   
End Sub


Private Sub Command6_Click()

  'titles do not wrap, so if the length of
  'the title is wider than the max width specified
  'for the tooltip, the tip widens to accommodate
  'the full tooltip title and, if specified, the icon.
  
  'valid icon values:
  '0 = No icon
  '1 = Info icon
  '2 = Warning icon
  '3 = Error Icon
  'greater than 3 = if using Windows XP SP2 or
  'later, you can assign a value representing
  'a hIcon (your own icon). Any value greater
  'than 3 is assumed to be a valid hIcon reference.
   tooltip_titleadd hwndTip, "VBnet ToolTip Basics Demo", 1

End Sub


Private Sub Command7_Click()

   tooltip_titledelete hwndTip
   
End Sub


Private Sub Command8_Click()

   tooltip_updatetext hwndTip, Text3.hwnd, "From the MSDN:" & _
                                           vbCrLf & vbCrLf & _
                                           "The maximum ToolTip width value " & _
                                           "does not indicate a ToolTip " & _
                                           "window's actual width."
End Sub


Private Sub Command9_Click()

   Call tooltip_destroy(hwndTip)
   
   Command1.Enabled = True
   Command2.Enabled = False
   Command3.Enabled = False
   Command4.Enabled = False
   Command5.Enabled = False
   Command6.Enabled = False
   Command7.Enabled = False
   Command8.Enabled = False
   Command9.Enabled = False
   
End Sub


Private Sub Timer1_Timer()

   Static cnt
   cnt = cnt + 1
   If cnt = 16 Then cnt = 1
    
   Select Case cnt
      Case 1: tooltip_updatetext hwndTip, Text1.hwnd, "Although this is not an example.."
      Case 2: tooltip_updatetext hwndTip, Text1.hwnd, "..of good interface design, it .."
      Case 3: tooltip_updatetext hwndTip, Text1.hwnd, "..does show how to change tooltip.."
      Case 4: tooltip_updatetext hwndTip, Text1.hwnd, "..text on-the-fly (and not affect.."
      Case 5: tooltip_updatetext hwndTip, Text1.hwnd, "..the text in other tooltips!).."
      Case 7, 8: 'wait 2 cycles to invoke a pause to digest the message so far
      Case 9: tooltip_updatetext hwndTip, Text1.hwnd, "..But, like a good scotch, this .."
      Case 10: tooltip_updatetext hwndTip, Text1.hwnd, "..effect is best kept under tight.."
      Case 11: tooltip_updatetext hwndTip, Text1.hwnd, "..wraps until circumstances really.."
      Case 12: tooltip_updatetext hwndTip, Text1.hwnd, "..warrant showing it to the world."
      Case Else 'wait another 4 cycles to invoke another pause
   End Select
   
End Sub


Private Sub tooltip_activate(hwndTip As Long)

   SendMessage hwndTip, TTM_ACTIVATE, 1, ByVal 0&
   
End Sub


Private Function tooltip_addtool(hwndTip As Long, _
                                 hwndControl As Long, _
                                 sTipText As String) As Long

   Dim ti As TOOLINFO
   Dim rc As RECT

   If hwndTip <> 0 Then
   
      GetClientRect hwndControl, rc
      
      With ti
        .cbSize = Len(ti)
        .uFlags = TTF_SUBCLASS Or TTF_IDISHWND
        .hwnd = hwndControl
        .hinst = App.hInstance
        .uid = hwndControl
        .lpszText = sTipText
        .rc = rc
      End With
      
      SendMessage hwndTip, TTM_ADDTOOL, 0&, ti

   End If  'hwndTip

End Function


Private Function tooltip_create(hwndForm As Long, _
                                bTipAsBalloon As Boolean, _
                                bTipAlways As Boolean) As Long

   Dim TTS_TIPSTYLE As Long
   Dim TTS_TIPALWAYS As Long
   
   TTS_TIPSTYLE = IIf(bTipAsBalloon = True, TTS_BALLOON, 0&)
   TTS_TIPALWAYS = IIf(bTipAlways = True, TTS_ALWAYSTIP, 0&)
   

   hwndTip = CreateWindowEx(WS_EX_TOPMOST, _
                            TOOLTIPS_CLASSA, _
                            vbNullString, _
                            WS_POPUP Or TTS_TIPSTYLE Or TTS_TIPALWAYS, _
                            CW_USEDEFAULT, CW_USEDEFAULT, _
                            CW_USEDEFAULT, CW_USEDEFAULT, _
                            hwndForm, _
                            0&, _
                            App.hInstance, _
                            ByVal 0&)

   SetWindowPos hwndTip, HWND_TOPMOST, 0, 0, 0, 0, _
                         SWP_NOMOVE Or SWP_NOSIZE Or SWP_NOACTIVATE

   tooltip_create = hwndTip
   
End Function


Private Sub tooltip_deactivate(hwndTip As Long)

   SendMessage hwndTip, TTM_ACTIVATE, 0, ByVal 0&
   
End Sub


Private Function tooltip_destroy(hwndTip As Long) As Long

   If hwndTip <> 0 Then
      Call DestroyWindow(hwndTip)
      hwndTip = 0
   End If
  
End Function


Private Sub tooltip_setmaxwidth(hwndTip As Long, dwNewWidth As Long)

  'Note: The maximum ToolTip width value does not
  'indicate a ToolTip window's actual width. Rather,
  'if a ToolTip string exceeds the maximum width,
  'the control breaks the text into multiple lines,
  'using spaces to determine line breaks. If the text
  'cannot be segmented into multiple lines, it will
  'be displayed on a single line. The length of this
  'line may exceed the maximum ToolTip width.
  '
  'New lines can also be inserted by including vbCrLf in any string
   
  'When 0 is passed, take that as a sign to have
  'the control reset to automatically determine
  'the required width. Note: specifying 0 allows
  'vbCrLf to introduce new lines in the tooltip
  'text message. Specifying -1, resets the width
  'as 0 does but causes the control to ignore new
  'line chars in the string (they are displayed
  'as blocks). To test this, pass -1 rather than
  '0 in Command5.
   SendMessage hwndTip, TTM_SETMAXTIPWIDTH, 0, ByVal dwNewWidth

End Sub


Private Sub tooltip_setbackcolour(hwndTip As Long, dwColour As Long)

   SendMessage hwndTip, TTM_SETTIPBKCOLOR, dwColour, ByVal 0&
      
End Sub


Private Sub tooltip_settextcolour(hwndTip As Long, dwColour As Long)

   SendMessage hwndTip, TTM_SETTIPTEXTCOLOR, dwColour, ByVal 0&
      
End Sub


Private Sub tooltip_titleadd(hwndTip As Long, sTipTitle As String, dwIconId As Long)

   SendMessage hwndTip, TTM_SETTITLE, dwIconId, ByVal sTipTitle

End Sub


Private Sub tooltip_titledelete(hwndTip As Long)

   SendMessage hwndTip, TTM_SETTITLE, 0&, ByVal vbNullString

End Sub


Private Sub tooltip_updatetext(hwndTip As Long, hwndControl As Long, sNewText As String)

   Dim ti As TOOLINFO
   
   With ti
      .cbSize = Len(ti)
      .hwnd = hwndControl
      .uid = hwndControl
      .lpszText = sNewText & vbNullString
      
       SendMessage hwndTip, TTM_UPDATETIPTEXT, 0&, ti
   
   End With
   
End Sub