continua dal post precedente

codice:
Public Property Get ForeColor() As OLE_COLOR
    If (m_hwndTT = 0) Then Exit Property
    ForeColor = SendMessage(m_hwndTT, TTM_SETTIPTEXTCOLOR, 0, 0)
End Property

Public Property Let ForeColor(clr As OLE_COLOR)
    If (m_hwndTT = 0) Then Exit Property
    Call SendMessage(m_hwndTT, TTM_SETTIPTEXTCOLOR, clr, 0)
End Property

Public Property Get hwnd() As Long   ' read-only
    hwnd = m_hwndTT
End Property

Public Property Get ToolCount() As Integer   ' read-only
    If (m_hwndTT = 0) Then Exit Property
    ToolCount = SendMessage(m_hwndTT, TTM_GETTOOLCOUNT, 0, 0)
End Property

Public Property Get MaxTipWidth() As Integer
    If (m_hwndTT = 0) Then Exit Property
    MaxTipWidth = LOWORD(SendMessage(m_hwndTT, TTM_GETMAXTIPWIDTH, 0, 0))
End Property

Public Property Let MaxTipWidth(ByVal cx As Integer)
    If (m_hwndTT = 0) Then Exit Property
    If (cx < 1) Then cx = -1
    Call SendMessage(m_hwndTT, TTM_SETMAXTIPWIDTH, 0, ByVal CLng(cx))
End Property

Public Property Get ToolText(CTRL As Control) As String

    If (m_hwndTT = 0) Then Exit Property
    If GetToolInfo(CTRL.hwnd, TI, True) Then
        ToolText = GetStrFromBufferA(TI.lpszText)
    End If

End Property

Public Property Let ToolText(CTRL As Control, sText As String)
  
    If (m_hwndTT = 0) Then Exit Property
    If GetToolInfo(CTRL.hwnd, TI) Then
        TI.lpszText = sText
        m_cMaxTip = Max(m_cMaxTip, Len(sText) + 1)
        Call SendMessage(m_hwndTT, TTM_UPDATETIPTEXT, 0, TI)
    End If

End Property


'########################################################################################
'#                                                                                      #
'#                              INTERFACCIA PRIVATA                                     #
'#                                                                                      #
'########################################################################################

Private Function IsWindow(CTRL As Control) As Boolean
On Error GoTo Out
    IsWindow = CBool(CTRL.hwnd)
Out:
End Function

Private Function LOWORD(dwValue As Long) As Integer
    MoveMemory LOWORD, dwValue, 2
End Function

Private Function Max(param1 As Long, param2 As Long) As Long
    If param1 > param2 Then Max = param1 Else Max = param2
End Function

Private Function GetStrFromBufferA(szA As String) As String
    If InStr(szA, vbNullChar) Then
        GetStrFromBufferA = Left$(szA, InStr(szA, vbNullChar) - 1)
    Else
        GetStrFromBufferA = szA
    End If
End Function

Private Function GetToolInfo(hwndTool As Long, _
    TI As TOOLINFO, _
    Optional fGetText As Boolean = False) As Boolean
Dim nItems As Integer
Dim i As Integer
  
    TI.cbSize = Len(TI)
    If fGetText Then TI.lpszText = String$(m_cMaxTip, 0)
      
    nItems = ToolCount
    
    For i = 0 To nItems - 1
        If SendMessage(m_hwndTT, TTM_ENUMTOOLS, (i), TI) Then
            If (hwndTool = TI.uId) Then
                GetToolInfo = True
                Exit Function
            End If
        End If
    Next

End Function

Private Function RemoveToolHwnd(CTRLHwnd As Long) As Boolean
    If (m_hwndTT = 0) Then Exit Function
    If GetToolInfo(CTRLHwnd, TI) Then
        Call SendMessage(m_hwndTT, TTM_DELTOOL, 0, TI)
        RemoveToolHwnd = True
    End If
End Function
da copiare nel form in cui inserire una textbox (Text1) e un commandbutton (Command1)

codice:
Option Explicit
Dim TT As cTooltip

Private Sub Command1_Click()
    Unload Me
End Sub

Private Sub Form_Load()

    Set TT = New cTooltip
    TT.DelayTime = 1000
    TT.VisibleTime = 15000
    If TT.Create(Me) Then

        TT.Title = "TOOLTIP MULTILINE"
        TT.Icon = TTIconInfo
        TT.AddTool Text1, "SCRIVI QUALCOSA"
        TT.AddTool Command1, "Struca el boton" & vbCrLf & "per uscire"

    End If
    Debug.Print "&H" & Hex(TT.BackColor)
    Debug.Print "&H" & Hex(TT.ForeColor)

End Sub

Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
    Set TT = Nothing
End Sub