Imports System
Imports System.Drawing
Imports System.Windows.Forms
Imports System.Runtime.InteropServices
Imports System.Collections.Generic
Imports System.Reflection
Imports System.ComponentModel
Imports System.Timers
Imports System.Text
Imports System.Text.RegularExpressions
Imports System.Data
Public Class ComboWithToolTips
Inherits ComboBox
Public Delegate Sub DropdownItemSelectedEventHandler(ByVal sender As Object, ByVal e As DropdownItemSelectedEventArgs)
Public Event DropdownItemSelected As DropdownItemSelectedEventHandler
' internal reference to tooltip object
Private _toolTip As ToolTip
''' <summary>
''' Indicates the property to use as text in item tooltips.
''' </summary>
<Category("Data")> _
<Description("Indicates the property to use as text in item tooltips.")> _
<Editor("System.Windows.Forms.Design.DataMemberFieldEditor, System.Design", GetType(System.Drawing.Design.UITypeEditor))> _
Public Property ToolTipMember() As String
Get
Return _toolTipMember
End Get
Set(ByVal value As String)
_toolTipMember = value
End Set
End Property
Private _toolTipMember As String
''' <summary>
''' The coordinates of the upper-left corner of the tooltip window relative to the item's lower-left corner.
''' </summary>
<Category("Layout")> _
<Description("The coordinates of the upper-left corner of the tooltip window relative to the item's lower-left corner.")> _
<DefaultValue(GetType(Point), "0, 0")> _
Public Property ToolTipOffset() As Point
Get
Return _toolTipOffset
End Get
Set(ByVal value As Point)
_toolTipOffset = value
End Set
End Property
Private _toolTipOffset As New Point(0, 0)
''' <summary>
''' The width, in pixels, of the tooltip window. Content will wrap as necessary. Default is 0 (no wrap).
''' </summary>
<Category("Behavior")> _
<Description("The width, in pixels, of the tooltip window. Content will wrap as necessary. Default is 0 (no wrap).")> _
<DefaultValue(0)> _
Public Property ToolTipWidth() As Integer
Get
Return _toolTipWidth
End Get
Set(ByVal value As Integer)
_toolTipWidth = value
End Set
End Property
Private _toolTipWidth As Integer = 0
''' <summary>
''' When true (default) tooltip is used to shows full text of dropdown items that are clipped by dropdown width.
''' Delay for this extended text is taken from ToolTip.ReshowDelay.
''' </summary>
<Category("Behavior")> _
<Description("When true (default) tooltip is used to shows full text of dropdown items that are clipped by dropdown width.")> _
<DefaultValue(True)> _
Public Property ExtendClippedItem() As Boolean
Get
Return _extendClippedItem
End Get
Set(ByVal value As Boolean)
_extendClippedItem = value
End Set
End Property
Private _extendClippedItem As Boolean = True
''' <summary>
''' Reading speed measured in characters per second.
''' Enables calculation of variable tooltip popup delay based on string length of its contents.
''' Such calculated delay cannot be less than ToolTip.AutoPopDelay.
''' </summary>
<Category("Behavior")> _
<Description("Text reading speed, in characters per second, used to calculate " & "tooltip popup delay based on text length.")> _
<DefaultValue(25)> _
Public Property ToolTipReadingSpeed() As Integer
Get
Return _readingSpeed
End Get
Set(ByVal value As Integer)
_readingSpeed = value
End Set
End Property
Private _readingSpeed As Integer = 25
Private mDropdown As DropdownWindow
Private mItemExtenders As List(Of String)
Private mExtendTimer As System.Timers.Timer
Private mItemToolTips As List(Of String)
Private mToolTipTimer As System.Timers.Timer
Private mHighlitedIndex As Integer
Private mHighlitedItemY As Integer
Private mGraphics As Graphics
Private mForm As Form
Private mToolTipIsBalloon As Boolean
Protected Overloads Overrides Sub OnCreateControl()
MyBase.OnCreateControl()
mForm = Me.FindForm()
mGraphics = Graphics.FromHwnd(mForm.Handle)
' initialize tool tip timers and strings
mExtendTimer = New System.Timers.Timer()
mExtendTimer.AutoReset = False
mExtendTimer.SynchronizingObject = Me
mItemExtenders = New List(Of String)()
mToolTipTimer = New System.Timers.Timer()
mToolTipTimer.AutoReset = False
mToolTipTimer.SynchronizingObject = Me
AddHandler mToolTipTimer.Elapsed, AddressOf mToolTipTimer_Elapsed
mItemToolTips = New List(Of String)()
AddHandler Me.DataSourceChanged, AddressOf ComboWithToolTips_DataSourceChanged
End Sub
' reset data members after the datasource property is changed in design mode
Private Sub ComboWithToolTips_DataSourceChanged(ByVal sender As Object, ByVal e As EventArgs)
If Me.DesignMode Then
ToolTipMember = Nothing
ValueMember = Nothing
End If
End Sub
Private Function getItemValue(ByVal item As Object, ByVal member As String) As String
If TypeOf item Is DataRowView Then
Return TryCast(item, DataRowView).Row(member).ToString()
End If
' otherwise try to use reflection to get to the item's value
Dim itemType As Type = item.[GetType]()
Dim itemValue As String = "Could not retrieve " & member & " value."
If itemType.GetMember(member).Length <> 0 Then
If itemType.GetMember(member)(0).MemberType = MemberTypes.Field Then
itemValue = itemType.GetField(member).GetValue(item).ToString()
ElseIf itemType.GetMember(member)(0).MemberType = MemberTypes.[Property] Then
itemValue = itemType.GetProperty(member).GetValue(item, Nothing).ToString()
End If
End If
Return itemValue
End Function
Protected Overloads Overrides Sub OnDropDown(ByVal e As EventArgs)
' Install wrapper
MyBase.OnDropDown(e)
' Retrieve handle to dropdown list
Dim info As New COMBOBOXINFO()
info.cbSize = Marshal.SizeOf(info)
SendMessageCb(Me.Handle, &H164, IntPtr.Zero, info)
mDropdown = New DropdownWindow(Me)
mDropdown.AssignHandle(info.hwndList)
' find associated tooltip component through reflection
Dim container As IContainer = DirectCast(mForm.[GetType]().GetField("components", BindingFlags.Instance Or BindingFlags.NonPublic).GetValue(mForm), IContainer)
If container IsNot Nothing Then
Dim components As ComponentCollection = container.Components
For Each c As Component In components
If TypeOf c Is ToolTip Then
Dim t As ToolTip = DirectCast(c, ToolTip)
If Not [String].IsNullOrEmpty(t.GetToolTip(Me)) Then
_toolTip = t
' baloons are not supported on items so save status until the dropdown is closed
mToolTipIsBalloon = t.IsBalloon
_toolTip.IsBalloon = False
' stop at the first participating tooltip
Exit For
End If
End If
Next
End If
' Populate extenders if required
If _toolTip IsNot Nothing AndAlso _extendClippedItem Then
mItemExtenders.Clear()
For Each item As Object In Items
If Not [String].IsNullOrEmpty(DisplayMember) Then
mItemExtenders.Add(getItemValue(item, DisplayMember))
Else
mItemExtenders.Add(item.ToString())
End If
Next
End If
' Populate tool tips from ToolTipMember
If _toolTip IsNot Nothing AndAlso Not [String].IsNullOrEmpty(_toolTipMember) Then
mItemToolTips.Clear()
For Each item As Object In Items
Dim itemToolTip As String = getItemValue(item, ToolTipMember)
' if tool tip width is specified then word wrap the content
If _toolTipWidth > 0 Then
itemToolTip = wordWrap(itemToolTip, SystemFonts.StatusFont, _toolTipWidth)
End If
mItemToolTips.Add(itemToolTip)
Next
End If
End Sub
Private Function wordWrap(ByVal s As String, ByVal font As Font, ByVal maxWidth As Integer) As String
Dim sb As New StringBuilder()
Dim pos As Integer = 0, lineStart As Integer = 0
Dim r As New Regex("\s")
While True
' find next white space
Dim m As Match = r.Match(s, pos)
If m.Success Then
' if next word would render out of specified maxWidth do a line break
If mGraphics.MeasureString(s.Substring(lineStart, m.Index - lineStart), font).Width > maxWidth Then
sb.Append(s.Substring(lineStart, pos - lineStart) + Environment.NewLine)
lineStart = pos
End If
pos = m.Index + 1
Else
sb.Append(s.Substring(lineStart, s.Length - lineStart))
Exit While
End If
End While
Return sb.ToString()
End Function
Protected Overloads Overrides Sub OnDropDownClosed(ByVal e As EventArgs)
' Remove wrapper
mDropdown.ReleaseHandle()
mDropdown = Nothing
If _toolTip IsNot Nothing Then
' hide tooltip and stop any elapsing timers
_toolTip.Hide(Me)
mExtendTimer.[Stop]()
mToolTipTimer.[Stop]()
' restore baloon state before resetting _toolTip reference to null
_toolTip.IsBalloon = mToolTipIsBalloon
_toolTip = Nothing
End If
MyBase.OnDropDownClosed(e)
OnSelect(-1, Rectangle.Empty, True)
End Sub
Friend Sub OnSelect(ByVal item As Integer, ByVal pos As Rectangle, ByVal scroll As Boolean)
pos = Me.RectangleToClient(pos)
' start timers for item tooltips if a tooltip is bound to this control
If _toolTip IsNot Nothing Then
_toolTip.Hide(Me)
mExtendTimer.[Stop]()
mToolTipTimer.[Stop]()
If Not scroll Then
mHighlitedIndex = item
mHighlitedItemY = pos.Y
Dim extenderDelay As Integer = 0
' check if we are displaying item extenders and only do it for the ones that are clipped
If _extendClippedItem AndAlso mGraphics.MeasureString(mItemExtenders(item), SystemFonts.StatusFont).Width > Me.Width Then
mExtendTimer.Interval = _toolTip.ReshowDelay
mExtendTimer.Start()
extenderDelay = mItemExtenders(item).Length * 1000 / _readingSpeed
extenderDelay = Math.Max(extenderDelay, _toolTip.AutoPopDelay)
End If
' display tooltips as well if ToolTipMember is set
If Not [String].IsNullOrEmpty(ToolTipMember) Then
If _extendClippedItem Then
mToolTipTimer.Interval = _toolTip.InitialDelay + extenderDelay
End If
mToolTipTimer.Start()
End If
End If
End If
' do the DropdownItemSelected event if one is bound
RaiseEvent DropdownItemSelected(Me, New DropdownItemSelectedEventArgs(item, pos, scroll))
End Sub
Private Sub mExtendTimer_Elapsed(ByVal sender As Object, ByVal e As ElapsedEventArgs)
Dim offset As New Point(0, mHighlitedItemY - 3)
_toolTip.Show(mItemExtenders(mHighlitedIndex), Me, offset)
End Sub
Private Sub mToolTipTimer_Elapsed(ByVal sender As Object, ByVal e As ElapsedEventArgs)
Dim delay As Integer = mItemToolTips(mHighlitedIndex).Length * 1000 / _readingSpeed
delay = Math.Max(delay, _toolTip.AutoPopDelay)
Dim offset As New Point(_toolTipOffset.X, mHighlitedItemY + Me.ItemHeight + _toolTipOffset.Y)
_toolTip.Show(mItemToolTips(mHighlitedIndex), Me, offset, delay)
End Sub
' Event handler arguments
Public Class DropdownItemSelectedEventArgs
Inherits EventArgs
Private mItem As Integer
Private mPos As Rectangle
Private mScroll As Boolean
Public Sub New(ByVal item As Integer, ByVal pos As Rectangle, ByVal scroll As Boolean)
mItem = item
mPos = pos
mScroll = scroll
End Sub
Public ReadOnly Property SelectedItem() As Integer
Get
Return mItem
End Get
End Property
Public ReadOnly Property Bounds() As Rectangle
Get
Return mPos
End Get
End Property
Public ReadOnly Property Scrolled() As Boolean
Get
Return mScroll
End Get
End Property
End Class
' Wrapper for combobox dropdown list
Private Class DropdownWindow
Inherits NativeWindow
Private Const WM_MOUSEMOVE As Integer = &H200, WM_MOUSEWHEEL As Integer = &H20A, WM_KEYDOWN As Integer = &H100, WM_VSCROLL As Integer = &H115, LB_GETCURSEL As Integer = &H188, LB_GETITEMRECT As Integer = &H198
Private mParent As ComboWithToolTips
Private mItem As Integer
Public Sub New(ByVal parent As ComboWithToolTips)
mParent = parent
mItem = -1
End Sub
Protected Overloads Overrides Sub WndProc(ByRef m As Message)
' All we're getting here is WM_MOUSEMOVE and WM_KEYDOWN, ask list for current selection for LB_GETCURSEL
Console.WriteLine(m.ToString())
MyBase.WndProc(m)
If m.Msg = WM_MOUSEMOVE OrElse m.Msg = WM_KEYDOWN Then
Dim item As Integer = CInt(SendMessage(Me.Handle, LB_GETCURSEL, IntPtr.Zero, IntPtr.Zero))
If item <> mItem Then
mItem = item
OnSelect(False)
End If
End If
If m.Msg = WM_VSCROLL OrElse m.Msg = WM_MOUSEWHEEL Then
' List scrolled, item position would change
OnSelect(True)
End If
End Sub
Private Sub OnSelect(ByVal scroll As Boolean)
Dim rc As New RECT()
SendMessageRc(Me.Handle, LB_GETITEMRECT, IntPtr.op_Explicit(mItem), rc)
MapWindowPoints(Me.Handle, IntPtr.Zero, rc, 2)
mParent.OnSelect(mItem, Rectangle.FromLTRB(rc.Left, rc.Top, rc.Right, rc.Bottom), scroll)
End Sub
End Class
' P/Invoke declarations
Private Structure COMBOBOXINFO
Public cbSize As Int32
Public rcItem As RECT
Public rcButton As RECT
Public buttonState As Integer
Public hwndCombo As IntPtr
Public hwndEdit As IntPtr
Public hwndList As IntPtr
End Structure
<StructLayout(LayoutKind.Sequential)> _
Private Structure RECT
Public Left As Integer
Public Top As Integer
Public Right As Integer
Public Bottom As Integer
End Structure
<DllImport("user32.dll", EntryPoint:="SendMessageW", CharSet:=CharSet.Unicode)> _
Private Shared Function SendMessageCb(ByVal hWnd As IntPtr, ByVal msg As Integer, ByVal wp As IntPtr, ByRef lp As COMBOBOXINFO) As IntPtr
End Function
<DllImport("user32.dll", EntryPoint:="SendMessageW", CharSet:=CharSet.Unicode)> _
Private Shared Function SendMessageRc(ByVal hWnd As IntPtr, ByVal msg As Integer, ByVal wp As IntPtr, ByRef lp As RECT) As IntPtr
End Function
<DllImport("user32.dll")> _
Private Shared Function SendMessage(ByVal hWnd As IntPtr, ByVal msg As Integer, ByVal wp As IntPtr, ByVal lp As IntPtr) As IntPtr
End Function
<DllImport("user32.dll")> _
Private Shared Function MapWindowPoints(ByVal hWndFrom As IntPtr, ByVal hWndTo As IntPtr, <[In](), Out()> ByRef rc As RECT, ByVal points As Integer) As Integer
End Function
Private Sub InitializeComponent()
Me.SuspendLayout()
Me.ResumeLayout(False)
End Sub
End Class
Private Sub ComboWithToolTips1_DropdownItemSelected(ByVal sender As System.Object, ByVal e As ComboWithToolTips.DropdownItemSelectedEventArgs) Handles ComboWithToolTips1.DropdownItemSelected
If e.SelectedItem < 0 OrElse e.Scrolled Then
ToolTip1.Hide(ComboWithToolTips1)
Else
ToolTip1.Show(ComboWithToolTips1.Items(e.SelectedItem).ToString(), ComboWithToolTips1, e.Bounds.Location)
End If
End Sub