''' <summary>
''' Represents a Windows picker box that displays Color values.
''' </summary>
<DefaultEvent("ValueChanged")>
<DefaultProperty("Value")>
Public Class ColorPicker
Inherits PickerBase
''' <summary>
''' Constructor
''' </summary>
Public Sub New()
MyBase.New(GetType(Color))
Value = Color.White
End Sub
''' <summary>
''' Value
''' </summary>
Public Shadows Property Value() As Color
Get
Return DirectCast(MyBase.Value, Color)
End Get
Set(value As Color)
MyBase.Value = value
End Set
End Property
<Browsable(False), EditorBrowsable(EditorBrowsableState.Never)> Overrides Property Text As String
End Class
''' <summary>
''' Represents a base class of a Windows Picker control that allows you to edit a value of any type.
''' </summary>
Public MustInherit Class PickerBase
Inherits ContainerControl
''' <summary>
''' Constructor
''' </summary>
''' <param name="type">The Type of object that can be edited by this control.</param>
Protected Sub New(type As Type)
MyBase.SetStyle(ControlStyles.Selectable, True)
MyBase.SetStyle(ControlStyles.FixedHeight, True)
MyBase.SetStyle(ControlStyles.DoubleBuffer Or ControlStyles.AllPaintingInWmPaint Or ControlStyles.UserPaint, True)
PickerButton1 = New PickerButton(Me)
PickerValueBox1 = New PickerValueBox(Me)
pickerTextBox = New TextBox()
PickerListBox1 = New PickerListBox(Me)
PickerService1 = New PickerService(Me)
MyBase.Controls.Add(PickerButton1)
MyBase.Controls.Add(PickerValueBox1)
MyBase.Controls.Add(pickerTextBox)
MyBase.ResumeLayout()
End Sub
Private m_editedType As Type
''' <summary>
''' Gets or sets the Type this control can edit.
''' </summary>
Protected Property EditedType() As Type
Get
Return m_editedType
End Get
Set(value As Type)
If m_editedType <> value Then
m_editedType = value
typeEditor = Nothing
typeConverter = Nothing
m_parseMethod = Nothing
LayoutControls()
MyBase.Invalidate(True)
End If
End Set
End Property
Private typeEditor As UITypeEditor
''' <summary>
''' Gets or sets the type editor for this control.
''' </summary>
Protected Property Editor() As UITypeEditor
Get
If typeEditor Is Nothing Then
typeEditor = DefaultEditor
End If
Return typeEditor
End Get
Set(value As UITypeEditor)
If typeEditor IsNot value Then
typeEditor = value
End If
End Set
End Property
''' <summary>
''' Gets the default type editor for this control.
''' </summary>
Protected ReadOnly Property DefaultEditor() As UITypeEditor
Get
Return DirectCast(TypeDescriptor.GetEditor(m_editedType, GetType(UITypeEditor)), UITypeEditor)
End Get
End Property
Private typeConverter As TypeConverter
''' <summary>
''' Gets or sets the type editor for this control.
''' </summary>
Protected Property Converter() As TypeConverter
Get
If typeConverter Is Nothing Then
typeConverter = DefaultConverter
End If
Return typeConverter
End Get
Set(value As TypeConverter)
If typeConverter IsNot value Then
typeConverter = value
End If
End Set
End Property
''' <summary>
''' Gets the default type editor for this control.
''' </summary>
Protected ReadOnly Property DefaultConverter() As TypeConverter
Get
Return TypeDescriptor.GetConverter(m_editedType)
End Get
End Property
Private m_parseMethod As MethodInfo
''' <summary>
''' Gets or sets the type parse method for this control.
''' </summary>
Protected Property ParseMethod() As MethodInfo
Get
If m_parseMethod Is Nothing Then
Dim array As Type() = New Type() {GetType(String), GetType(IFormatProvider)}
m_parseMethod = EditedType.GetMethod("Parse", array)
End If
Return m_parseMethod
End Get
Set(value As MethodInfo)
If m_parseMethod <> value Then
m_parseMethod = value
End If
End Set
End Property
Private typeContext As ITypeDescriptorContext
''' <summary>
''' Gets or sets the context that will be used to convert the edited value using type converters.
''' </summary>
Public Property Context() As ITypeDescriptorContext
Get
Return typeContext
End Get
Set(value As ITypeDescriptorContext)
If (typeContext Is Nothing) OrElse Not typeContext.Equals(value) Then
typeContext = value
End If
End Set
End Property
Private m_autoCompletion As Boolean
''' <summary>
''' Gets or sets a value indicating whether to auto completion.
''' </summary>
Protected Property AutoCompletion() As Boolean
Get
Return m_autoCompletion
End Get
Set(value As Boolean)
If m_autoCompletion <> value Then
m_autoCompletion = value
End If
End Set
End Property
''' <summary>
''' Gets or sets a value indicating whether to support paint value.
''' </summary>
Protected ReadOnly Property PaintValueSupported() As Boolean
Get
If Editor IsNot Nothing Then
Return Editor.GetPaintValueSupported()
End If
Return False
End Get
End Property
Private m_textEditable As Boolean
''' <summary>
''' Gets or sets a value indicating whether can edit text.
''' </summary>
Protected Property TextEditable() As Boolean
Get
Return m_textEditable
End Get
Set(value As Boolean)
If m_textEditable <> value Then
m_textEditable = value
End If
End Set
End Property
Private m_paintValueOnly As Boolean
''' <summary>
''' Gets or sets a value indicating whether to show only the rectangle that displays a representation of the edited value.
''' </summary>
Protected Property PaintValueOnly() As Boolean
Get
Return m_paintValueOnly
End Get
Set(value As Boolean)
If m_paintValueOnly <> value Then
m_paintValueOnly = value
LayoutControls()
MyBase.Invalidate(True)
End If
End Set
End Property
Private m_paintValueFrame As Boolean
''' <summary>
''' Gets or sets a value indicating whether a frame around the area that previews the edited value is displayed or not.
''' </summary>
Protected Property PaintValueFrame() As Boolean
Get
Return m_paintValueFrame
End Get
Set(value As Boolean)
If m_paintValueFrame <> value Then
m_paintValueFrame = value
End If
End Set
End Property
Private m_paintValueWidth As Integer
''' <summary>
''' Gets or sets the width of the value painter.
''' </summary>
Protected Property PaintValueWidth() As Integer
Get
Return m_paintValueWidth
End Get
Set(value As Integer)
If m_paintValueWidth <> value Then
m_paintValueWidth = value
End If
End Set
End Property
Private editedValue As Object = Nothing
''' <summary>
''' Gets or sets the value edited by the control.
''' </summary>
Public Property Value() As Object
Get
Return editedValue
End Get
Set(value As Object)
SetValue(value)
End Set
End Property
''' <summary>
''' Gets or sets the prederred height of the control.
''' </summary>
Public ReadOnly Property PreferredHeight() As Integer
Get
Return MyBase.FontHeight + SystemInformation.BorderSize.Height * 4 + 3
End Get
End Property
''' <summary>
''' Gets or sets a value indicating whether text in the text box is read-only.
''' </summary>
Public Property [ReadOnly]() As Boolean
Get
Return pickerTextBox.[ReadOnly]
End Get
Set(value As Boolean)
If [ReadOnly] <> value Then
pickerTextBox.[ReadOnly] = value
PickerValueBox1.Enabled = Not value
PickerButton1.Enabled = Not value
MyBase.Invalidate(True)
OnReadOnlyChanged(New EventArgs())
End If
End Set
End Property
''' <summary>
''' Gets or sets the text associated with this control.
''' </summary>
Public Overrides Property Text() As String
Get
Return pickerTextBox.Text
End Get
Set(value As String)
If Text <> value Then
CommitText(value)
End If
End Set
End Property
''' <summary>
''' Gets a value indicating whether the control has input focus.
''' </summary>
Public Overrides ReadOnly Property Focused() As Boolean
Get
Return MyBase.ContainsFocus
End Get
End Property
''' <summary>
''' Occurs when the ReadOnly property is changed on the control.
''' </summary>
Public Event ReadOnlyChanged As EventHandler
''' <summary>
''' Occurs when the Value property is changed on the control.
''' </summary>
Public Event ValueChanged As EventHandler
Private PickerButton1 As PickerButton
Private PickerValueBox1 As PickerValueBox
Private pickerTextBox As TextBox
Private PickerListBox1 As PickerListBox
Private PickerService1 As PickerService
Private dropDownCommit As Boolean
Private editingText As Boolean
Private Sub LayoutControls()
' Get Inner Client Rectangle
Dim inner As Rectangle = MyBase.ClientRectangle
inner.Inflate(-2, -2)
Dim buttonwidth As Integer = SystemInformation.VerticalScrollBarWidth
'17
Dim split As Integer = 4
PickerValueBox1.Visible = True
pickerTextBox.Visible = True
End If
Else
pickerTextBox.SetBounds(editor.X, editor.Y, editor.Width, editor.Height)
PickerValueBox1.Visible = False
pickerTextBox.Visible = True
End If
End Sub
Private Sub AdjustHeight()
MyBase.Height = PreferredHeight
End Sub
Private Function CommitText(text As String) As Boolean
Dim value As Object = Nothing
Try
If Converter IsNot Nothing AndAlso Converter.CanConvertFrom(typeContext, GetType(String)) Then
value = Converter.ConvertFromString(typeContext, CultureInfo.CurrentUICulture, text)
End If
Dim parse As MethodInfo = ParseMethod
If (value Is Nothing) AndAlso (parse IsNot Nothing) Then
value = parse.Invoke(Nothing, New Object() {text})
End If
Catch
End Try
If value Is Nothing Then
Return False
End If
Return CommitValue(value)
End Function
Private Function CommitValue(value As Object) As Boolean
Try
PickerService1.CloseDropDown()
SetValue(value)
Return True
Catch
Return False
End Try
End Function
Private Sub CommitList()
Dim item As Object = PickerListBox1.SelectedItem
dropDownCommit = False
If item IsNot Nothing Then
CommitValue(item)
End If
End Sub
Private Function CanTextEditable() As Boolean
If TextEditable AndAlso (Not PaintValueOnly OrElse Not PaintValueSupported) Then
If Converter IsNot Nothing Then
Return Converter.CanConvertFrom(typeContext, GetType(String))
End If
End If
Return False
End Function
Private Function IsEnumerable() As Boolean
If Converter IsNot Nothing AndAlso Converter.GetStandardValuesSupported(typeContext) AndAlso (Converter.GetStandardValues(typeContext).Count <> 0) Then
Return True
End If
Return False
End Function
Private Function IsDropDown() As Boolean
If Editor IsNot Nothing Then
Return Editor.GetEditStyle() <> UITypeEditorEditStyle.Modal
End If
Return True
End Function
Private Function GetValueList() As Object()
Dim values As Object() = Nothing
If Converter.GetStandardValuesSupported(typeContext) Then
Dim collection As ICollection = Converter.GetStandardValues(typeContext)
values = New Object(collection.Count - 1) {}
collection.CopyTo(values, 0)
End If
Return values
End Function
Private Function GetValueAsText(value As Object) As String
If value Is Nothing Then
Return String.Empty
End If
If TypeOf value Is String Then
Return DirectCast(value, String)
End If
Try
If Converter IsNot Nothing AndAlso Converter.CanConvertTo(typeContext, GetType(String)) Then
Return Converter.ConvertToString(typeContext, CultureInfo.CurrentUICulture, value)
End If
Catch
End Try
Return value.ToString()
End Function
Private Function UpdateTextWithValue() As Boolean
Dim text As String = GetValueAsText(Value)
If text Is Nothing Then
pickerTextBox.Text = String.Empty
Return False
End If
If pickerTextBox.Text <> text Then
pickerTextBox.Text = text
Return True
End If
Return False
End Function
Private Sub SetValue(value As Object)
If value IsNot Nothing Then
If Convert.IsDBNull(value) Then
value = Nothing
End If
If value IsNot Nothing AndAlso Not EditedType.IsAssignableFrom(value.[GetType]()) Then
Throw New InvalidCastException("PickerBase.Value : Bad value type.")
End If
End If
If editedValue = value OrElse (editedValue IsNot Nothing AndAlso value IsNot Nothing AndAlso editedValue.Equals(value)) Then
UpdateTextWithValue()
Else
editedValue = value
If UpdateTextWithValue() Then
pickerTextBox.SelectionStart = 0
pickerTextBox.SelectionLength = 0
End If
If PaintValueSupported Then
MyBase.Invalidate(True)
End If
OnValueChanged(New EventArgs())
End If
End Sub
Private Sub DoDropDown()
If (Editor Is Nothing) OrElse (Editor.GetEditStyle() = UITypeEditorEditStyle.None) Then
If Not IsEnumerable() Then
Return
End If
Dim array As Object() = GetValueList()
PickerListBox1.Items.Clear()
Using graphics As Graphics = MyBase.CreateGraphics()
Dim width As Integer = 0
Dim font As Font = PickerListBox1.Font
For Each item As Object In array
If Not PickerListBox1.Items.Contains(item) Then
Dim text As String = GetValueAsText(item)
If Not PaintValueOnly Then
Dim size As SizeF = graphics.MeasureString(text, font)
width = CInt(Math.Max(CSng(width), size.Width))
End If
PickerListBox1.Items.Add(item)
End If
Next
If Me.PaintValueSupported Then
width += 24
End If
Dim bound As Rectangle = MyBase.Bounds
PickerListBox1.SelectedItem = Value
PickerListBox1.Height = CInt(Math.Max(font.GetHeight() + 2.0F, CSng(Math.Min(200, PickerListBox1.PreferredHeight))))
PickerListBox1.Width = Math.Max(width, bound.Width - 2)
dropDownCommit = False
PickerService1.DropDownControl(PickerListBox1)
Return
End Using
End If
Try
Dim value__1 As Object = Editor.EditValue(PickerService1, Value)
CommitValue(value__1)
Catch
End Try
End Sub
Private Function ProcessEditorKey(key As Keys) As Boolean
If Not [ReadOnly] Then
If key = Keys.Delete Then
Return Not CanTextEditable()
End If
Dim alt As Boolean = (key And Keys.Alt) <> Keys.None
Dim data As Keys = key And Keys.KeyCode
If key = Keys.F4 OrElse (alt AndAlso data = Keys.Down) Then
DoDropDown()
Return True
End If
If Not alt AndAlso (data = Keys.Down OrElse data = Keys.Up) Then
If IsEnumerable() Then
SelectEnumerableValue(data <> Keys.Down)
Return True
End If
End If
End If
Return False
End Function
Private Sub SelectEnumerableValue([next] As Boolean)
If Not IsEnumerable() Then
Return
End If
Dim index As Integer
Dim array As Object() = GetValueList()
index = If([next], (array.Length - 1), 0)
For i As Integer = 0 To array.Length - 1
If array(i).Equals(Value) Then
If [next] Then
If i = 0 Then
Return
End If
index = i - 1
Exit For
End If
If i = (array.Length - 1) Then
Return
End If
index = i + 1
Exit For
End If
Next
CommitValue(array(index))
pickerTextBox.SelectAll()
End Sub
Private Sub PaintBorder(g As Graphics)
If VisualStyleRenderer.IsSupported Then
ComboBoxRenderer.DrawTextBox(g, MyBase.ClientRectangle, ComboBoxState.Normal)
Dim bound As Rectangle = MyBase.ClientRectangle
bound.Inflate(-1, -1)
Using brush As Brush = New SolidBrush(BackColor)
g.FillRectangle(brush, bound)
End Using
Else
Using brush As Brush = New SolidBrush(BackColor)
g.FillRectangle(brush, MyBase.ClientRectangle)
End Using
ControlPaint.DrawBorder3D(g, MyBase.ClientRectangle, Border3DStyle.Sunken)
End If
End Sub
Private Sub PickerButton1_MouseDown(sender As Object, e As MouseEventArgs)
If e.Button = MouseButtons.Left AndAlso PickerButton1.DropDown Then
MyBase.Focus()
DoDropDown()
End If
End Sub
Private Sub PickerButton1_MouseUp(sender As Object, e As MouseEventArgs)
If e.Button = MouseButtons.Left AndAlso Not PickerButton1.DropDown Then
MyBase.Focus()
DoDropDown()
End If
End Sub
Private Sub PickerValueBox1_MouseDown(sender As Object, e As MouseEventArgs)
If e.Button = MouseButtons.Left Then
MyBase.Focus()
If Not CanTextEditable() Then
DoDropDown()
End If
End If
End Sub
Private Sub pickerTextBox_KeyDown(sender As Object, e As KeyEventArgs)
OnKeyDown(e)
End Sub
Private Sub pickerTextBox_KeyUp(sender As Object, e As KeyEventArgs)
OnKeyUp(e)
editingText = False
End Sub
Private Sub pickerTextBox_KeyPress(sender As Object, e As KeyPressEventArgs)
editingText = (e.KeyChar <> ChrW(27)) AndAlso (e.KeyChar <> ControlChars.Back)
OnKeyPress(e)
End Sub
Private Sub pickerTextBox_TextChanged(sender As Object, e As EventArgs)
OnTextChanged(e)
If AutoCompletion AndAlso editingText AndAlso CanTextEditable() Then
editingText = False
If Converter IsNot Nothing AndAlso Converter.GetStandardValuesSupported(typeContext) Then
Dim text__1 As String = Text.ToUpper()
If text__1.Length <> 0 Then
Dim collection As ICollection = Converter.GetStandardValues(typeContext)
For Each item As Object In collection
Dim itemtext As String = Converter.ConvertToString(typeContext, CultureInfo.CurrentUICulture, item)
If itemtext.ToUpper().StartsWith(text__1) Then
pickerTextBox.Text = itemtext
pickerTextBox.[Select](text__1.Length, itemtext.Length - text__1.Length)
Return
End If
Next
End If
End If
End If
End Sub
Private Sub pickerTextBox_GotFocus(sender As Object, e As EventArgs)
MyBase.Invalidate(True)
End Sub
Private Sub pickerTextBox_LostFocus(sender As Object, e As EventArgs)
MyBase.Invalidate(True)
End Sub
Private Sub pickerTextBox_Validated(sender As Object, e As EventArgs)
End Sub
Private Sub pickerTextBox_Validating(sender As Object, e As CancelEventArgs)
End Sub
Private Sub PickerListBox1_MouseUp(sender As Object, e As MouseEventArgs)
If e.Button = MouseButtons.Left Then
CommitList()
End If
End Sub
Private Sub PickerListBox1_SelectedIndexChanged(sender As Object, e As EventArgs)
dropDownCommit = True
End Sub
''' <summary>
''' Determines whether the specified key is a regular input key or a special key that requires preprocessing.
''' </summary>
''' <param name="key">One of the Keys values.</param>
''' <returns>true if the specified key is a regular input key; otherwise, false.</returns>
Protected Overrides Function IsInputKey(key As Keys) As Boolean
If key = Keys.Delete Then
Return True
End If
Return MyBase.IsInputKey(key)
End Function
''' <summary>
''' Processes a dialog key.
''' </summary>
''' <param name="key">One of the Keys values that represents the key to process.</param>
''' <returns>true if the key was processed by the control; otherwise, false.</returns>
Protected Overrides Function ProcessDialogKey(key As Keys) As Boolean
If Not ProcessEditorKey(key) Then
Return MyBase.ProcessDialogKey(key)
End If
Return True
End Function
''' <summary>
''' Performs the work of scaling the entire control and any child controls.
''' </summary>
''' <param name="dx">The ratio by which to scale the control horizontally.</param>
''' <param name="dy">The ratio by which to scale the control vertically.</param>
Protected Overrides Sub ScaleCore(dx As Single, dy As Single)
MyBase.ScaleCore(dx, dy)
LayoutControls()
End Sub
''' <summary>
''' Performs the work of setting the specified bounds of this control.
''' </summary>
''' <param name="x">The new Left property value of the control.</param>
''' <param name="y">The new Right property value of the control.</param>
''' <param name="width">The new Width property value of the control.</param>
''' <param name="height">The new Height property value of the control.</param>
''' <param name="specified">A bitwise combination of the BoundsSpecified values.</param>
Protected Overrides Sub SetBoundsCore(x As Integer, y As Integer, width As Integer, height As Integer, specified As BoundsSpecified)
If height <> MyBase.Height Then
height = PreferredHeight
End If
MyBase.SetBoundsCore(x, y, width, height, specified)
LayoutControls()
End Sub
''' <summary>
''' Raises the BackColorChanged event.
''' </summary>
''' <param name="e">The event data.</param>
Protected Overrides Sub OnBackColorChanged(e As EventArgs)
pickerTextBox.BackColor = BackColor
MyBase.OnBackColorChanged(e)
End Sub
''' <summary>
''' Raises the CursorChanged event.
''' </summary>
''' <param name="e">The event data.</param>
Protected Overrides Sub OnCursorChanged(e As EventArgs)
MyBase.OnCursorChanged(e)
pickerTextBox.Cursor = Cursor
End Sub
''' <summary>
''' Raises the EnabledChanged event.
''' </summary>
''' <param name="e">The event data.</param>
Protected Overrides Sub OnEnabledChanged(e As EventArgs)
MyBase.OnEnabledChanged(e)
pickerTextBox.Enabled = MyBase.Enabled
PickerButton1.Enabled = MyBase.Enabled
End Sub
''' <summary>
''' Raises the Enter event.
''' </summary>
''' <param name="e">The event data.</param>
Protected Overrides Sub OnEnter(e As EventArgs)
MyBase.OnEnter(e)
MyBase.Invalidate(True)
End Sub
''' <summary>
''' Raises the FontChanged event.
''' </summary>
''' <param name="e">The event data.</param>
Protected Overrides Sub OnFontChanged(e As EventArgs)
pickerTextBox.Font = Font
MyBase.OnFontChanged(e)
AdjustHeight()
End Sub
''' <summary>
''' Raises the ForeColorChanged event.
''' </summary>
''' <param name="e">The event data.</param>
Protected Overrides Sub OnForeColorChanged(e As EventArgs)
pickerTextBox.ForeColor = ForeColor
MyBase.OnForeColorChanged(e)
End Sub
''' <summary>
''' Raises the GotFocus event.
''' </summary>
''' <param name="e">The event data.</param>
Protected Overrides Sub OnGotFocus(e As EventArgs)
MyBase.OnGotFocus(e)
If pickerTextBox.Visible Then
pickerTextBox.Focus()
End If
End Sub
''' <summary>
''' Raises the HandleCreated event.
''' </summary>
''' <param name="e">The event data.</param>
Protected Overrides Sub OnHandleCreated(e As EventArgs)
MyBase.OnHandleCreated(e)
AdjustHeight()
LayoutControls()
End Sub
''' <summary>
''' Raises the KeyDown event.
''' </summary>
''' <param name="e">The event data.</param>
Protected Overrides Sub OnKeyDown(e As KeyEventArgs)
If ProcessEditorKey(e.KeyData) Then
e.Handled = True
End If
MyBase.OnKeyDown(e)
End Sub
''' <summary>
''' Raises the KeyPress event.
''' </summary>
''' <param name="e">The event data.</param>
Protected Overrides Sub OnKeyPress(e As KeyPressEventArgs)
If Not CanTextEditable() Then
e.Handled = True
End If
MyBase.OnKeyPress(e)
End Sub
''' <summary>
''' Raises the Leave event.
''' </summary>
''' <param name="e">The event data.</param>
Protected Overrides Sub OnLeave(e As EventArgs)
PickerService1.HideHolder()
MyBase.OnLeave(e)
MyBase.Invalidate(True)
End Sub
''' <summary>
''' Raises the MouseDown event.
''' </summary>
''' <param name="e">The event data.</param>
Protected Overrides Sub OnMouseDown(e As MouseEventArgs)
MyBase.OnMouseDown(e)
End Sub
''' <summary>
''' Raises the MouseWheel event.
''' </summary>
''' <param name="e">The event data.</param>
Protected Overrides Sub OnMouseWheel(e As MouseEventArgs)
If Control.ModifierKeys = Keys.None Then
If Focused AndAlso Not [ReadOnly] Then
If IsEnumerable() Then
SelectEnumerableValue(e.Delta > 0)
End If
End If
MyBase.OnMouseWheel(e)
End If
End Sub
''' <summary>
''' Raises the Paint event.
''' </summary>
''' <param name="e">The event data.</param>
Protected Overrides Sub OnPaint(e As PaintEventArgs)
MyBase.OnPaint(e)
PaintBorder(e.Graphics)
End Sub
''' <summary>
''' Raises the SystemColorsChanged event.
''' </summary>
''' <param name="e">The event data.</param>
Protected Overrides Sub OnSystemColorsChanged(e As EventArgs)
MyBase.OnSystemColorsChanged(e)
PickerService1.SystemColorsChanged()
End Sub
''' <summary>
''' Raises the Validating event.
''' </summary>
''' <param name="e">The event data.</param>
Protected Overrides Sub OnValidating(e As CancelEventArgs)
PickerService1.HideHolder()
If Not CommitText(pickerTextBox.Text) Then
e.Cancel = True
End If
MyBase.OnValidating(e)
End Sub
''' <summary>
''' Raises the ReadOnlyChanged event.
''' </summary>
''' <param name="e">The event data.</param>
Protected Overridable Sub OnReadOnlyChanged(e As EventArgs)
RaiseEvent ReadOnlyChanged(Me, e)
End Sub
''' <summary>
''' Raises the OnValueChanged event.
''' </summary>
''' <param name="e">The event data.</param>
Protected Overridable Sub OnValueChanged(e As EventArgs)
RaiseEvent ValueChanged(Me, e)
End Sub
#Region "PickerButton"
Private Class PickerButton
Inherits Button
Public Sub New(parent As PickerBase)
parentControl = parent
isDropDown = False
buttonHot = False
buttonPressed = False
MyBase.SetStyle(ControlStyles.Selectable, False)
End Sub
Private parentControl As PickerBase
Private buttonPressed As Boolean
Private buttonHot As Boolean
Private isDropDown As Boolean
Public Property DropDown() As Boolean
Get
Return isDropDown
End Get
Set(value As Boolean)
isDropDown = value
MyBase.Invalidate()
End Set
End Property
Protected Overrides Sub OnGotFocus(e As EventArgs)
MyBase.OnGotFocus(e)
parentControl.Invalidate(True)
End Sub
Protected Overrides Sub OnLostFocus(e As EventArgs)
MyBase.OnLostFocus(e)
parentControl.Invalidate(True)
End Sub
Protected Overrides Sub OnMouseDown(e As MouseEventArgs)
If e.Button = MouseButtons.Left Then
buttonPressed = True
MyBase.Invalidate()
End If
MyBase.OnMouseDown(e)
End Sub
Protected Overrides Sub OnMouseUp(e As MouseEventArgs)
MyBase.OnMouseUp(e)
If e.Button = MouseButtons.Left Then
buttonPressed = False
MyBase.Invalidate()
End If
End Sub
Protected Overrides Sub OnMouseEnter(e As EventArgs)
MyBase.OnMouseEnter(e)
buttonHot = True
MyBase.Invalidate()
End Sub
Protected Overrides Sub OnMouseLeave(e As EventArgs)
MyBase.OnMouseLeave(e)
buttonHot = False
MyBase.Invalidate()
End Sub
Protected Overrides Sub OnPaint(e As PaintEventArgs)
Dim g As Graphics = e.Graphics
Dim bounds As Rectangle = MyBase.ClientRectangle
If isDropDown Then
If VisualStyleRenderer.IsSupported Then
Dim state As ComboBoxState = If(MyBase.Enabled, (If(buttonPressed, ComboBoxState.Pressed, (If(buttonHot, ComboBoxState.Hot, ComboBoxState.Normal)))), ComboBoxState.Disabled)
ComboBoxRenderer.DrawDropDownButton(g, bounds, state)
Else
Dim state As ButtonState = If(MyBase.Enabled, (If(buttonPressed, ButtonState.Pushed, ButtonState.Normal)), ButtonState.Inactive)
ControlPaint.DrawComboButton(g, bounds, state)
End If
Else
If VisualStyleRenderer.IsSupported Then
ButtonRenderer.DrawParentBackground(g, bounds, Me)
Dim state As PushButtonState = If(MyBase.Enabled, (If(buttonPressed, PushButtonState.Pressed, (If(buttonHot, PushButtonState.Hot, PushButtonState.Normal)))), PushButtonState.Disabled)
ButtonRenderer.DrawButton(g, bounds, state)
Else
MyBase.OnPaint(e)
End If
Dim x As Integer = bounds.Left + bounds.Width / 2 - 4
Dim y As Integer = bounds.Bottom - 5
Using brush As Brush = New SolidBrush(If(MyBase.Enabled, SystemColors.ControlText, SystemColors.GrayText))
g.FillRectangle(brush, x, y, 1, 2)
g.FillRectangle(brush, x + 4, y, 1, 2)
g.FillRectangle(brush, x + 8, y, 1, 2)
End Using
End If
End Sub
Protected Overrides Sub SetBoundsCore(x As Integer, y As Integer, width As Integer, height As Integer, specified As BoundsSpecified)
MyBase.SetBoundsCore(x, y, width, height, specified)
End Sub
End Class
#End Region
#Region "PickerValueBox"
Private Class PickerValueBox
Inherits Control
Public Sub New(parent As PickerBase)
parentControl = parent
MyBase.SetStyle(ControlStyles.Selectable, False)
End Sub
Private parentControl As PickerBase
Protected Overrides Sub OnPaint(e As PaintEventArgs)
Dim g As Graphics = e.Graphics
Dim bounds As Rectangle = MyBase.ClientRectangle
Using brush As Brush = New SolidBrush(parentControl.BackColor)
g.FillRectangle(brush, bounds)
End Using
If parentControl.PaintValueFrame Then
Using pen As New Pen(parentControl.ForeColor)
g.DrawRectangle(pen, bounds.X, bounds.Y, bounds.Width - 1, bounds.Height - 1)
End Using
End If
End Sub
End Class
#End Region
#Region "PickerService"
Private Class PickerService
Implements IServiceProvider
Implements IWindowsFormsEditorService
Public Sub New(parent As PickerBase)
parentControl = parent
End Sub
Private parentControl As PickerBase
Private closingDropDown As Boolean
Private dropDownHolder As DropDownHolder
Public ReadOnly Property Picker() As PickerBase
Get
Return parentControl
End Get
End Property
Public Sub CancelEditing()
HideHolder()
End Sub
Public Sub HideHolder()
If (dropDownHolder IsNot Nothing) AndAlso dropDownHolder.Visible Then
dropDownHolder.Visible = False
End If
End Sub
Public Sub SystemColorsChanged()
If dropDownHolder IsNot Nothing Then
dropDownHolder.SystemColorChanged()
End If
End Sub
Public Sub ValidateEditing()
parentControl.dropDownCommit = True
CloseDropDown()
End Sub
Public Function GetService(serviceType As System.Type) As Object Implements System.IServiceProvider.GetService
If serviceType = GetType(IWindowsFormsEditorService) Then
Return Me
End If
Return Nothing
End Function
Public Sub CloseDropDown() Implements System.Windows.Forms.Design.IWindowsFormsEditorService.CloseDropDown
If Not closingDropDown Then
Try
closingDropDown = True
If (dropDownHolder Is Nothing) OrElse Not dropDownHolder.Visible Then
Return
End If
If (dropDownHolder.Component Is parentControl.PickerListBox1) AndAlso parentControl.dropDownCommit Then
parentControl.CommitList()
End If
dropDownHolder.SetComponent(Nothing)
dropDownHolder.Visible = False
If parentControl.pickerTextBox.Visible Then
parentControl.pickerTextBox.Focus()
End If
Finally
closingDropDown = False
End Try
End If
End Sub
Public Sub DropDownControl(control As System.Windows.Forms.Control) Implements System.Windows.Forms.Design.IWindowsFormsEditorService.DropDownControl
If dropDownHolder Is Nothing Then
dropDownHolder = New DropDownHolder(Me)
End If
control.RightToLeft = parentControl.RightToLeft
dropDownHolder.Visible = False
dropDownHolder.SetComponent(control)
Dim rectparent As Rectangle = parentControl.Bounds
Dim size As Size = dropDownHolder.Size
Dim point As Point = parentControl.Parent.PointToScreen(New Point(0, 0))
Dim rectworking As Rectangle = Screen.GetWorkingArea(control.MousePosition)
If parentControl.RightToLeft = RightToLeft.No Then
point.X = Math.Min((rectworking.X + rectworking.Width) - size.Width, Math.Max(rectworking.X, ((point.X + rectparent.X) + rectparent.Width) - size.Width))
Else
point.X = Math.Min((rectworking.X + rectworking.Width) - size.Width, Math.Max(rectworking.X, point.X + rectparent.X))
End If
point.Y += rectparent.Y
If (rectworking.Y + rectworking.Height) < (size.Height + point.Y + parentControl.pickerTextBox.Height) Then
point.Y -= size.Height
Else
point.Y = point.Y + rectparent.Height + 1
End If
dropDownHolder.SetBounds(point.X, point.Y, size.Width, size.Height)
dropDownHolder.Visible = True
dropDownHolder.FocusComponent()
parentControl.pickerTextBox.SelectAll()
dropDownHolder.DoModalLoop()
End Sub
Public Function ShowDialog(dialog As System.Windows.Forms.Form) As System.Windows.Forms.DialogResult Implements System.Windows.Forms.Design.IWindowsFormsEditorService.ShowDialog
Return dialog.ShowDialog(parentControl)
End Function
End Class
#End Region
#Region "DropDownHoster"
Private Class DropDownHolder
Inherits Form
Public Sub New(service As PickerService)
currentControl = Nothing
parentService = service
Text = ""
Private currentControl As Control
Private parentService As PickerService
Public Overridable ReadOnly Property Component() As Control
Get
Return currentControl
End Get
End Property
Public Sub DoModalLoop()
While MyBase.Visible
'UnsafeNativeMethods.MsgWaitForMultipleObjects(1, 0, true, 250, 0xff);
Application.DoEvents()
End While
End Sub
Public Overridable Sub FocusComponent()
If (currentControl IsNot Nothing) AndAlso MyBase.Visible Then
currentControl.Focus()
End If
End Sub
Public Overridable Sub SetComponent(control As Control)
If currentControl IsNot Nothing Then
MyBase.Controls.Remove(Me.currentControl)
currentControl = Nothing
End If
If control IsNot Nothing Then
MyBase.Controls.Add(control)
MyBase.Size = New Size(2 + control.Width, 2 + control.Height)
control.Location = New Point(0, 0)
control.Visible = True
currentControl = control
AddHandler currentControl.Resize, AddressOf OnCurrentControlResize
End If
MyBase.Enabled = currentControl IsNot Nothing
End Sub
Public Sub SystemColorChanged()
OnSystemColorsChanged(EventArgs.Empty)
End Sub
Private Sub OnCurrentControlResize(o As Object, e As EventArgs)
If currentControl IsNot Nothing Then
Dim width As Integer = MyBase.Width
MyBase.Size = New Size(2 + currentControl.Width, 2 + currentControl.Height)
If currentControl.RightToLeft = RightToLeft.No Then
MyBase.Left -= MyBase.Width - width
End If
End If
End Sub
Protected Overrides Sub OnClosed(e As EventArgs)
If MyBase.Visible Then
parentService.CancelEditing()
End If
MyBase.OnClosed(e)
End Sub
Protected Overrides Sub OnDeactivate(e As EventArgs)
If MyBase.Visible Then
parentService.CancelEditing()
End If
MyBase.OnDeactivate(e)
End Sub
Protected Overrides Sub OnMouseDown(e As MouseEventArgs)
If e.Button = MouseButtons.Left Then
parentService.ValidateEditing()
End If
MyBase.OnMouseDown(e)
End Sub
Protected Overrides Function ProcessDialogKey(key As Keys) As Boolean
If (key And (Keys.Alt Or Keys.Control Or Keys.Shift)) = Keys.None Then
Dim keys__1 As Keys = key And Keys.KeyCode
If keys__1 = Keys.[Return] Then
parentService.ValidateEditing()
Return True
End If
If keys__1 = Keys.Escape Then
parentService.CancelEditing()
Return True
End If
End If
Return MyBase.ProcessDialogKey(key)
End Function
Protected Overrides Sub SetBoundsCore(x As Integer, y As Integer, width As Integer, height As Integer, specified As BoundsSpecified)
If currentControl IsNot Nothing Then
currentControl.SetBounds(0, 0, width - 2, height - 2)
width = currentControl.Width
height = currentControl.Height
If (height = 0) AndAlso (TypeOf currentControl Is ListBox) Then
height = DirectCast(currentControl, ListBox).ItemHeight
currentControl.Height = height
End If
width += 2
height += 2
End If
MyBase.SetBoundsCore(x, y, width, height, specified)
End Sub
End Class
#End Region
#Region "PickerListBox"
Private Class PickerListBox
Inherits ListBox
Public Sub New(parent As PickerBase)
MyBase.IntegralHeight = False
DrawMode = DrawMode.OwnerDrawVariable
parentControl = parent
End Sub
Private parentControl As PickerBase
Protected Overrides ReadOnly Property CreateParams() As CreateParams
Get
Dim param As CreateParams = MyBase.CreateParams
param.Style = param.Style And -8388609
' 0xFF7FFFFF: No border
param.ExStyle = param.ExStyle And -513
' 0xFFFFFDFF: No client edge
Return param
End Get
End Property
Protected Overrides Sub OnMeasureItem(e As MeasureItemEventArgs)
e.ItemHeight += 1
End Sub
Protected Overrides Sub OnDrawItem(e As DrawItemEventArgs)
e.DrawBackground()
If (e.Index >= 0) AndAlso (e.Index < MyBase.Items.Count) Then
Dim data As Object = MyBase.Items(e.Index)
Dim textrect As Rectangle = e.Bounds
Dim valuerect As Rectangle = e.Bounds
If parentControl.PaintValueSupported Then
valuerect.Height -= 1
If parentControl.PaintValueOnly Then
valuerect.X += 2
valuerect.Width -= 5
Else
valuerect.Width = parentControl.PaintValueWidth
valuerect.X += 2
textrect.X += parentControl.PaintValueWidth + 6
textrect.Width -= parentControl.PaintValueWidth - 6
End If
parentControl.Editor.PaintValue(data, e.Graphics, valuerect)
Dim pen As New Pen(ForeColor)
Try
If parentControl.PaintValueFrame Then
e.Graphics.DrawRectangle(pen, valuerect)
End If
Finally
pen.Dispose()
End Try
End If
If Not parentControl.PaintValueOnly OrElse Not parentControl.PaintValueSupported Then
Dim brush As Brush = New SolidBrush(e.ForeColor)
Try
e.Graphics.DrawString(parentControl.GetValueAsText(data), Font, brush, textrect)
Finally
brush.Dispose()
End Try
End If
End If