Full Color Balloon ToolTips with Icon / Title

dynamic_sysop

Well-known member
Joined
Oct 1, 2002
Messages
1,039
Location
Ashby, Leicestershire.
I built this Custom Balloon ToolTip to pass a bit of time between feeding babies etc...
To initially retrieve the Handle of the ToolTip i have used the method that Divil uses in his balloon tip example.
Then ive built up the code to perform Color / Icon / Title addition to the balloon.
Code:
    Private Sub Form1_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load
        ToolTip1.SetToolTip(Button1, Button1.Text)
        Dim tp As New CustomTip()
        tp.CustomBalloon(ToolTip1)
    End Sub
End Class

/// the Class that will build your Custom ToolTip...
#Region " Custom ToolTip Builder "
Public Class CustomTip
    Private Enum ToolTipIcon
        TTI_INFO = 1
        TTI_WARNING = 2
        TTI_ERROR = 3
    End Enum

    Private Enum ToolTipStyle
        TTS_BALLOON = 64
        WS_BORDER = 8388608
        TTS_NOPREFIX = 2
        TTM_SETTITLE = 1056
        TTM_UPDATETIPTEXT = 1036
        TTM_SETTIPBKCOLOR = 1043
        TTM_SETTIPTEXTCOLOR = 1044
    End Enum

    Public Sub CustomBalloon(ByVal tip As ToolTip, Optional ByVal style As Integer = 0)
        /// the first 5 lines are from Divils Balloon tip example
        /// ive marked them with a * at the end.
        /// start of *
        Dim hwnd As NativeWindow = DirectCast(GetType(ToolTip).GetField("window", Reflection.BindingFlags.NonPublic Or Reflection.BindingFlags.Instance).GetValue(tip), NativeWindow) /// *
        style = Win32.GetWindowLong(hwnd.Handle, Win32.GWL_STYLE) /// *
        style = style Xor ToolTipStyle.WS_BORDER /// *
        style = style Or ToolTipStyle.TTS_BALLOON Or ToolTipStyle.TTS_NOPREFIX /// *
        Win32.SetWindowLong(hwnd.Handle, Win32.GWL_STYLE, style) /// *
        /// end of *
        /// the remaining code , for colors / caption / icon is all by me ( Dynamic Sysop )
        /// no to set the caption / icon & colors up...
        SetToolTipCaption(hwnd, "this is the Caption")
        SetToolTipBackColor(hwnd, Color.GhostWhite)
        SetToolTipForeColor(hwnd, Color.BlueViolet)
    End Sub

    Private Sub SetToolTipCaption(ByVal tip As NativeWindow, ByVal Caption As String)
        Win32.SendMessage(tip.Handle, ToolTipStyle.TTM_SETTITLE, ToolTipIcon.TTI_WARNING, Caption)
    End Sub

    Private Sub SetToolTipBackColor(ByVal tip As NativeWindow, ByVal c As Color)
        /// set the back color of the tooltip
        Dim Col As Integer = ColorTranslator.ToWin32(Color.FromArgb(Convert.ToInt32(c.R), Convert.ToInt32(c.G), Convert.ToInt32(c.B)))
        Win32.SetToolColors(tip.Handle, ToolTipStyle.TTM_SETTIPBKCOLOR, Col, 0)
    End Sub

    Private Sub SetToolTipForeColor(ByVal tip As NativeWindow, ByVal c As Color)
        /// set the back color of the tooltip
        Dim Col As Integer = ColorTranslator.ToWin32(Color.FromArgb(Convert.ToInt32(c.R), Convert.ToInt32(c.G), Convert.ToInt32(c.B)))
        Win32.SetToolColors(tip.Handle, ToolTipStyle.TTM_SETTIPTEXTCOLOR, Col, 0)
    End Sub

End Class
#End Region
/// the Win32 Api calls to be used by the above Class...
#Region " Win32 Api Calls "
Public Class Win32

    Public Declare Function SendMessage Lib "user32.dll" Alias "SendMessageA" (ByVal hwnd As IntPtr, ByVal wMsg As Integer, ByVal wParam As Integer, ByVal lParam As String) As Integer
    Public Declare Function SetToolColors Lib "user32.dll" Alias "SendMessageA" (ByVal hwnd As IntPtr, ByVal wMsg As Integer, ByVal wParam As Integer, ByVal lParam As Integer) As Integer
    Public Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hwnd As IntPtr, ByVal nIndex As Integer) As Integer
    Public Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As IntPtr, ByVal nIndex As Integer, ByVal dwNewLong As Integer) As Integer
    Public Const GWL_STYLE As Integer = (-16)

End Class
#End Region
included is a Zipped project.
 

Attachments

im running Whidbey and heres a surprise , no apis needed for pretty much the same thing :mad:
Code:
        Dim tp As New ToolTip /// this is the default tooltip in whidbey ( no apis involved )

        With tp
            .IsBalloon = True /// Make as a Balloon Tooltip
            .ToolTipIcon = ToolTipIcon.Info
            .StripAmpersands = True
            .UseAnimation = True
            .SetToolTip(Button1, "tooltip on button1")
        End With
:-\
 
Back
Top