You can not select more than 25 topics
Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.
67 lines
3.2 KiB
67 lines
3.2 KiB
#Region " Custom ToolTip Builder "
|
|
Public Class clsBalloon
|
|
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 Divil's Balloon tip example
|
|
'/// i've 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, "HOT-Keys")
|
|
SetToolTipBackColor(hwnd, Color.LemonChiffon)
|
|
SetToolTipForeColor(hwnd, Color.Black)
|
|
End Sub
|
|
|
|
Private Sub SetToolTipCaption(ByVal tip As NativeWindow, ByVal Caption As String)
|
|
Win32.SendMessage(tip.Handle, ToolTipStyle.TTM_SETTITLE, ToolTipIcon.TTI_INFO, 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
|
|
|