Introduction
I wanted to create a control to provide a different user experience from usual for the selection of an item from a list.
Background
I created a new control by inheriting directly from the Control class, and inserting into it components a bitmap (which will be used to display the current item) and a popup (to display the scrollable list of elements).
Above and below the selected item is to be an area to directly select the previous or next item. The Item selection done by two areas, performs an animation to show the change performing:
The second way to select an item is you drag the mouse up or down, starting from any point on the control. The elements will be a list of any type of object convertible into String:
Code Description
I divide the code into three areas: first to define custom properties and events, the second for user interaction, the third for the representation of the data. The code is fully commented and (hopefully) easily understandable.
Some Notes
Private components As System.ComponentModel.IContainer
Private WithEvents PctCurrentItem As System.Windows.Forms.PictureBox
Private WithEvents PctItemList As System.Windows.Forms.PictureBox
Private WithEvents PopUpD As ToolStripDropDown
Private PopUpHost As ToolStripControlHost
Private WithEvents Tmr As New Timer With {.Interval = 10}
Public Sub New()
PopUpD = New ToolStripDropDown
PctCurrentItem = New PictureBox
PctItemList = New PictureBox
PopUpHost = New ToolStripControlHost(PctItemList)
Me.Controls.Add(PctCurrentItem)
PopUpD.Items.Add(PopUpHost)
Me_FontChanged(Nothing, Nothing)
End Sub
Private Sub Me_FontChanged(sender As Object, e As EventArgs) Handles Me.FontChanged
Dim TextSize As SizeF = PctCurrentItem.CreateGraphics().MeasureString_
("0", PctCurrentItem.Font)
PctCurrentItem.Height = CInt(TextSize.Height + 2)
Me.MinimumSize = New System.Drawing.Size(CInt(TextSize.Width * 1.5), _
PctCurrentItem.Height + 10)
Me_Resize(Nothing, Nothing)
End Sub
Private Sub Me_GotFocus(sender As Object, e As EventArgs) _
Handles Me.GotFocus, Me.LostFocus
Me.Invalidate()
End Sub
I made the control to be up at least 50% more than the height of the font used to render the elements to give space to the previous / next select area. I do not know if it could be a wrong or questionable mode, but it seemed that it was the easiest way to force the user to reserve that space, but still allow to create a great liking.
Changing the font of the control performs the scaling of the internal elements and the setting of minimum size, as well as perform repositioning of internal controls and the next refresh (via Me_Resize).
The GotFocus and the LostFocus events are to invalidate the area because the focus is showing.
About Properties and Events
Public Event CurrentIndexChanged(sender As Object, e As EventArgs)
Private _ArrowWidth As Single = 1
<System.ComponentModel.Browsable(True)>
<System.ComponentModel.DefaultValue(1.0!)>
Public Property ArrowWidth As Single
Get
Return _ArrowWidth
End Get
Set(value As Single)
If _ArrowWidth <> value Then
_ArrowWidth = value
Me.Invalidate()
End If
End Set
End Property
Private _ArrowColor As Color = Color.DarkGray
<System.ComponentModel.Browsable(True)>
<System.ComponentModel.DefaultValue(GetType(Color), "DarkGray")>
Public Property ArrowColor As Color
Get
Return _ArrowColor
End Get
Set(value As Color)
If _ArrowColor <> value Then
_ArrowColor = value
Me.Invalidate()
End If
End Set
End Property
Private Property _Items As Array = New Object() {}
<System.ComponentModel.Browsable(True)>
Public Property Items As Array
Get
Return _Items
End Get
Set(value As Array)
If value.GetUpperBound(0) <> _Items.GetUpperBound(0) _
OrElse (value.GetUpperBound(0) >= 0 AndAlso Enumerable.Range(0, _
_Items.GetUpperBound(0)).Any(Function(x As Integer) value.GetValue(x) _
IsNot _Items.GetValue(x))) Then
_Items = value
If _CurrentIndex > _Items.GetUpperBound(0) _
Then _CurrentIndex = _Items.GetUpperBound(0)
PctCurrentItem.Invalidate()
End If
End Set
End Property
Private _CurrentIndex As Integer = 0
<System.ComponentModel.Browsable(True)>
<System.ComponentModel.DefaultValue(0)>
Public Property CurrentIndex As Integer
Get
Return _CurrentIndex
End Get
Set(value As Integer)
If value < 0 Then value = 0
If value > _Items.GetUpperBound(0) Then value = _Items.GetUpperBound(0)
If value <> _CurrentIndex Then
_CurrentIndex = value
PctCurrentItem.Invalidate()
RaiseEvent CurrentIndexChanged(Me, New EventArgs)
End If
End Set
End Property
Public ReadOnly Property CurrentItem As Object
Get
If _CurrentIndex >= 0 AndAlso _CurrentIndex <= Items.GetUpperBound(0) _
Then Return Items.GetValue(_CurrentIndex) Else Return Nothing
End Get
End Property
I tried to make the property have the Browsable attribute added, and a default value, to permit the edit via the Property panel. I have not been able to put a default value in the Items property. I put the items in a first time as a String array, but I realized that it might be more usable if the items could be an array of any type of object (e.g., the statepattern), and display the string representation. This has made that there couldn't exist a default value, and a harder (or impossible) editability of the elements from the properties panel, but I think that it's better that way. It may be better if the Items property could be not browsable.
The CurrentIndex changing raise the event CurrentIndexChanged. I made all references to the current index into the code through the _CurrentIndex field, but when it will be set, I used the property making code fast (is a my method of work: if the get is so tricky, I use the get when I want that the internal code is to be managed, I use the field when not) and smart (when I want to set, I want the event is raised).
About User Interaction
Private LastMouseDownY As Integer
Private IsDragging As Boolean
Private StartDragYLocation As Integer
Private MinDragMultiplier As Single
Private MaxDragMultiplier As Single
Private CurrentDragYAmount As Integer
Private PictureContentCurrentTop As Integer
Private PictureListCurrentTop As Integer
Private MaxItemCountHeightInPanel As Integer = 7
Private Sub PctCurrentItem_MouseDown(sender As Object, e As MouseEventArgs) _
Handles Me.MouseDown, PctCurrentItem.MouseDown
If Not IsDragging AndAlso e.Button = Windows.Forms.MouseButtons.Left Then
Me_Resize(Nothing, Nothing)
LastMouseDownY = Me.PointToClient(Control.MousePosition).Y
End If
IsDragging = False
If PopUpD.Visible Then PopUpD.Close()
End Sub
Private Sub PctCurrentItem_MouseUp(sender As Object, e As MouseEventArgs) _
Handles Me.MouseUp, PctCurrentItem.MouseUp
If Not IsDragging AndAlso e.Button = _
Windows.Forms.MouseButtons.Left AndAlso _Items.GetUpperBound(0) >= 0 Then
If LastMouseDownY <= PctCurrentItem.Top + PctCurrentItem.Height * 0.2F Then
CurrentIndex = If(_CurrentIndex = 0, Items.GetUpperBound(0), _CurrentIndex - 1)
AnimationDirectionIsUp = True
ElseIf LastMouseDownY >= PctCurrentItem.Top + PctCurrentItem.Height * 0.8F Then
CurrentIndex = If(_CurrentIndex = Items.GetUpperBound(0), 0, _CurrentIndex + 1)
AnimationDirectionIsUp = False
Else
Exit Sub
End If
AnimationStartTime = Now
Tmr_Tick(Nothing, Nothing)
End If
End Sub
Private Sub PctCurrentItem_MouseMove(sender As Object, e As MouseEventArgs) _
Handles Me.MouseMove, PctCurrentItem.MouseMove
If e.Button = Windows.Forms.MouseButtons.Left _
AndAlso Not IsDragging _
AndAlso (Me.PointToClient(Control.MousePosition).Y - LastMouseDownY > 5 _
OrElse Me.PointToClient(Control.MousePosition).Y - LastMouseDownY < -5) _
AndAlso _Items.GetUpperBound(0) >= 0 Then
IsDragging = True
Dim PanelHeight As Integer = PctCurrentItem.Height * _
If(Items.GetUpperBound(0) < MaxItemCountHeightInPanel, _
Items.GetUpperBound(0) + 1, MaxItemCountHeightInPanel)
If PanelHeight > My.Computer.Screen.WorkingArea.Height * 0.8F _
Then PanelHeight = CInt(My.Computer.Screen.WorkingArea.Height * 0.8F)
PictureListCurrentTop = CInt(Me.PointToScreen(New Point(0, 0)).Y + _
Me.Height / 2.0F - PanelHeight / 2.0F)
PictureContentCurrentTop = PctCurrentItem.PointToScreen(New Point(0, 0)).Y
If PictureListCurrentTop < 0 Then PictureListCurrentTop = 0
If PictureListCurrentTop + PanelHeight > _
My.Computer.Screen.WorkingArea.Height - 5 _
Then PictureListCurrentTop = My.Computer.Screen.WorkingArea.Height - _
PanelHeight - 5
If My.Computer.Screen.WorkingArea.Height * 0.8! > PctCurrentItem.Height * _
(Items.GetUpperBound(0) + 1) Then
MinDragMultiplier = 1
Else
MinDragMultiplier = (PctCurrentItem.Height * _
(Items.GetUpperBound(0) + 1)) / 0.8! / My.Computer.Screen.WorkingArea.Height
End If
If MinDragMultiplier > 3 Then
MaxDragMultiplier = ((Items.GetUpperBound(0) + 1) / 2.0! - _
My.Computer.Screen.WorkingArea.Height * 0.8! / 6 / _
PctCurrentItem.Height) / (My.Computer.Screen.WorkingArea.Height / _
4.0! / PctCurrentItem.Height)
MinDragMultiplier = 3
Else
MaxDragMultiplier = MinDragMultiplier
End If
StartDragYLocation = Control.MousePosition.Y
CurrentDragYAmount = 0
Dim Sz As New Size(Me.Width, CInt(PanelHeight) + 2)
PopUpD.MinimumSize = Sz
PopUpD.MaximumSize = Sz
PopUpD.Size = Sz
PopUpHost.Size = Sz
PctItemList.Size = New Size(Sz.Width - 2, Sz.Height - 2)
PopUpD.Show(Me.PointToScreen(New Point(0, 0)).X - 1, CInt(PictureListCurrentTop))
Tmr.Start()
End If
End Sub
Private Sub PopUpD_Opened(sender As Object, e As EventArgs) Handles PopUpD.Opened
PctItemList.Location = New Point(1, 1)
End Sub
The MouseDown is only to store the current Y location of the mouse click. It's also reset the dragging event.
The MouseUp performs the selection changing if there is no drag. If the pointer is into the upper area or into the lower area, it will be selected the previous/next element. And it will be shown via the animation made by the timer.
Into the MouseMove, I put a threshold to see if the user is performing a drag into the PctCurrentItem_MouseMove:
Me.PointToClient(Control.MousePosition).Y - LastMouseDownY > 5 _
OrElse Me.PointToClient(Control.MousePosition).Y - LastMouseDownY < -5
If the threshold is passed, it calculates the position and height of the panel of the item list, the drag multiplier (see below), and the size of the popup panel. Then it shows the popup panel and makes the timer start performing the actions. When the popup is shown, the picture with the item list is positioned into it.
I put a multiplier to ensure that the drag was not directly raised to the amount of mouse movement, but that was directly proportional. If the total element height was less of the 80% of the screen height (to scroll the entire list in a single gesture), the drag and the scroll was of the same amount. If the total element height was more of the 80% of the screen height, the DragMultiplier was to do all the list scroll into the 80% of the screen height. In a second time, I realized that if the elements were really many, a direct multiplier was not very easy to use. So I created a MinDragMultiplier and a MaxDragMultiplier which are respectively:
If the size of the entire list height is less of three times of 80% screen height, they have that value, elsewhere, MinDragMultiplier value is 3, the other one has the value to perform the entire scroll list into the 40% of all screen height, having the DragMultiplier like the diagram:
Protected Overrides Function IsInputKey(KeyData As Keys) As Boolean
Return KeyData = Keys.Escape OrElse KeyData = Keys.Up OrElse KeyData = Keys.Down
End Function
Private Sub Me_KeyDown(sender As Object, e As KeyEventArgs) Handles Me.KeyDown
If IsDragging AndAlso e.KeyCode = Keys.Escape Then
PopUpD.Close()
IsDragging = False
Tmr.Stop()
e.Handled = True
ElseIf Not IsDragging AndAlso e.KeyCode = Keys.Up Then
LastMouseDownY = 0
PctCurrentItem_MouseUp(Me, New MouseEventArgs_
(Windows.Forms.MouseButtons.Left, 1, 0, 0, 0))
e.Handled = True
ElseIf Not IsDragging AndAlso e.KeyCode = Keys.Down Then
LastMouseDownY = Me.Height
PctCurrentItem_MouseUp(Me, New MouseEventArgs_
(Windows.Forms.MouseButtons.Left, 1, 0, Me.Height, 0))
e.Handled = True
End If
End Sub
I can also select the previous/next element with the Up and Down key arrows (they are to be set as Input Keys, elsewhere the Windows Forms performs the focus to go to the previous/next control)
Also the Esc key performs to close the popup window without performing the mouse selection during the drawing. It will be checked while the left mouse button is still down.
About Rendering Region
Private AnimationStartTime As Date
Private AnimationDirectionIsUp As Boolean
Private AnimationStep As Single
Private Sub Tmr_Tick(sender As Object, e As EventArgs) Handles Tmr.Tick
If IsDragging Then
If Control.MouseButtons = Windows.Forms.MouseButtons.Left Then
Dim DragMultiplier As Single = MaxDragMultiplier
If DragMultiplier > MinDragMultiplier Then
If (StartDragYLocation - Control.MousePosition.Y) / _
My.Computer.Screen.WorkingArea.Height < 0.25 _
AndAlso (Control.MousePosition.Y - StartDragYLocation) / _
My.Computer.Screen.WorkingArea.Height < 0.25 Then
DragMultiplier = MinDragMultiplier
ElseIf (StartDragYLocation - Control.MousePosition.Y) / _
My.Computer.Screen.WorkingArea.Height > 0.5 _
OrElse (Control.MousePosition.Y - StartDragYLocation) / _
My.Computer.Screen.WorkingArea.Height > 0.5 Then
DragMultiplier = MaxDragMultiplier
Else
DragMultiplier = MinDragMultiplier + _
(MaxDragMultiplier - MinDragMultiplier) * _
(CSng(Math.Abs(StartDragYLocation - Control.MousePosition.Y)) / _
My.Computer.Screen.WorkingArea.Height - 0.25!) * 4
End If
End If
Dim TmpCurrenty As Integer = _
CInt((StartDragYLocation - Control.MousePosition.Y) * DragMultiplier)
If CurrentDragYAmount <> TmpCurrenty _
Then CurrentDragYAmount = TmpCurrenty : PctItemList.Invalidate()
Else
Dim NewItem As Double = _CurrentIndex + _
CurrentDragYAmount / PctCurrentItem.Height
While NewItem < -0.5 : NewItem += _Items.GetUpperBound(0) + 1 : End While
While NewItem > _Items.GetUpperBound(0) + 0.5 : _
NewItem -= _Items.GetUpperBound(0) + 1 : End While
CurrentIndex = CInt(NewItem)
PopUpD.Close()
IsDragging = False
Tmr.Stop()
End If
Else
Dim TmpAnimationStep As Single = CSng((Now - AnimationStartTime).TotalSeconds * 4)
If TmpAnimationStep >= 1 Then
AnimationStep = 0
PctCurrentItem.Invalidate()
Tmr.Stop()
Else
AnimationStep = (1 - TmpAnimationStep) * If(AnimationDirectionIsUp, -1, 1)
Tmr.Start()
End If
PctCurrentItem.Invalidate()
End If
End Sub
The Tmr timer has two different functions: if the user chooses the previous/next element (by clicking into the upper/down region or by pressing the Up/Down key arrow, the IsDragging field is False), it performs an animation to show the selection changing (it set an AnimationStep and the picture invalidation, then the Paint event performs the animation) or controls the list interaction: if the left mouse button is still pressed, calculate the actual list position via the DragMultiplier as shown above, and the CurrentDragYAmount is the distance between the current item position into the PctCurrentItem and the Current item position to show into the PctItemList, if the left mouse isn't still pressed, performs the new item selection.
Private Sub PnlCurrentItem_Paint(sender As Object, e As PaintEventArgs) _
Handles PctCurrentItem.Paint
If _CurrentIndex >= 0 AndAlso _CurrentIndex <= Items.GetUpperBound(0) Then
Dim Str As String = Items.GetValue(_CurrentIndex).ToString(), _
SizeStr As SizeF = e.Graphics.MeasureString(Str, PctCurrentItem.Font)
If AnimationStep = 0 Then
e.Graphics.DrawString(Str, PctCurrentItem.Font, _
New SolidBrush(Me.ForeColor), _
CInt(PctCurrentItem.Width / 2 - SizeStr.Width / 2), 1)
Else
e.Graphics.DrawString(Str, PctCurrentItem.Font, _
New SolidBrush(Me.ForeColor), _
CInt(PctCurrentItem.Width / 2 - SizeStr.Width / 2), _
1 + AnimationStep * SizeStr.Height)
Dim Indx As Integer = _CurrentIndex + If(AnimationDirectionIsUp, 1, -1)
If Indx < 0 Then
Indx = Items.GetUpperBound(0)
ElseIf Indx > Items.GetUpperBound(0) Then
Indx = 0
End If
Str = Items.GetValue(Indx).ToString()
SizeStr = e.Graphics.MeasureString(Str, PctCurrentItem.Font)
e.Graphics.DrawString(Str, PctCurrentItem.Font, _
New SolidBrush(Me.ForeColor), _
CInt(PctCurrentItem.Width / 2 - SizeStr.Width / 2), _
1 + AnimationStep * SizeStr.Height + PctCurrentItem.Height * _
If(AnimationDirectionIsUp, 1, -1))
End If
End If
If Not Me.Enabled Then e.Graphics.FillRectangle(New SolidBrush_
(Color.FromArgb(128, 255, 255, 255)), 0, 0, PctCurrentItem.Width, _
PctCurrentItem.Height)
End Sub
The painting of the CurrentItem performs the animation framing (if an animation is running), or shows the current item as is done. The last row performs a fading if the control is disabled.
Private Sub PctItemList_Paint(sender As Object, e As PaintEventArgs) _
Handles PctItemList.Paint
If IsDragging Then
Dim CurrentY As Integer = PictureContentCurrentTop - _
PictureListCurrentTop - _CurrentIndex * PctCurrentItem.Height - _
CurrentDragYAmount, Str As String, SizeStr As SizeF
While CurrentY > 0 : CurrentY -= PctCurrentItem.Height * _
(_Items.GetUpperBound(0) + 1) : End While
While CurrentY < -PctCurrentItem.Height * _
(_Items.GetUpperBound(0) + 1) : CurrentY += PctCurrentItem.Height * _
(_Items.GetUpperBound(0) + 1) : End While
For I As Integer = 0 To 1
For J As Integer = 0 To Items.GetUpperBound(0)
If CurrentY > -PctCurrentItem.Height AndAlso CurrentY < _
PctItemList.Height Then
Str = Items.GetValue(J).ToString()
SizeStr = e.Graphics.MeasureString(Str, Me.Font)
e.Graphics.DrawString(Str, Me.Font, _
New SolidBrush(Me.ForeColor), _
CInt(Me.Width / 2 - SizeStr.Width / 2), CurrentY)
End If
CurrentY += PctCurrentItem.Height
Next J
Next I
e.Graphics.DrawRectangle(New Pen(Color.FromArgb(64, 0, 0, 0)), 0, _
PictureContentCurrentTop - PictureListCurrentTop, _
PctItemList.Width - 1, PctCurrentItem.Height)
End If
End Sub
During the dragging, the timer raises the ItemList invalidation to seem like an animation of the scrolling. Indeed are drawn only those elements that are visible in the visible area.
It would be more efficient if it calculates the upper item to show and the current position, but today I'm lazy. :-)
Finally: the arrow painting:
Private Sub Me_Paint(sender As Object, e As PaintEventArgs) Handles Me.Paint
Dim SizeArrow As Single = PctCurrentItem.Top - 1
Dim ArrowWidth As Single = SizeArrow / 4
e.Graphics.DrawLines(New Pen(ArrowColor, ArrowWidth * _ArrowWidth), _
{New PointF(Me.Width / 2.0F - SizeArrow * 2, SizeArrow), _
New PointF(Me.Width / 2.0F, 0), New PointF(Me.Width / 2.0F + _
SizeArrow * 2, SizeArrow)})
e.Graphics.DrawLines(New Pen(ArrowColor, ArrowWidth * _ArrowWidth), _
{New PointF(Me.Width / 2.0F - SizeArrow * 2, Me.Height - SizeArrow), _
New PointF(Me.Width / 2.0F, Me.Height - 0), New PointF(Me.Width / 2.0F + _
SizeArrow * 2, Me.Height - SizeArrow)})
If Me.Focused Then e.Graphics.DrawRectangle(New Pen(SystemColors.Highlight) _
With {.DashStyle = Drawing2D.DashStyle.Dash}, 0, 0, Me.Width - 1, Me.Height - 1)
If Not Me.Enabled Then e.Graphics.FillRectangle(New SolidBrush_
(Color.FromArgb(128, 255, 255, 255)), 0, 0, Me.Width, Me.Height)
End Sub
And the control positioning when there would be a resizing:
Private Sub Me_Resize(sender As Object, e As EventArgs) Handles Me.Resize
PctCurrentItem.Left = 1
PctCurrentItem.Width = Me.Width - 2
PctCurrentItem.Top = (Me.Height - PctCurrentItem.Height) \ 2
Me.Invalidate()
End Sub
Using the Control
The ItemList can be set by a simple assignment. To set the hours of a alarm, you can do both the sequences:
DlcHour.Items = New String() {"00 am", "01 am", "02 am", [...] "11 am", "12 pm", "01 pm", .. }
or:
DlcHour.Items = Enumerable.Range(0, 24).Select(Function(x As Integer) x.ToString("00")).ToArray()
To set an array of StatePattern:
DlcSetUp.Items = New Object () {StatePattern1, StatePattern2, StatePattern3}
To intercept the User Selection, you can use the CurrentIndexChanged event.
In the attached example, I pointed out some different ways to use the control. I used it to select an element from an array of strings:
DLCString.Items = {"First Element", "Second Element", "Third Element", "Fourth Element"}
An array of integers:
DLCAThousand.Items = Enumerable.Range(0, 1000).ToArray()
An array of formatted numbers:
DLCMinutes.Items = Enumerable.Range(0, 60).Select(Function(x) x.ToString("00")).ToArray()
An array of enumerated values:
DLCObjects1.Items = [Enum].GetValues(GetType(FormBorderStyle))
And an array of objects:
Private Class AClass
Public Property Descr As String
Public Property Value As Color
Public Overrides Function ToString() As String
Return Descr
End Function
End Class
Dim MyArray As AClass() = {New AClass With {.Descr = "Red", .Value = Color.Red},
New AClass With {.Descr = "Green", .Value = Color.Green},
New AClass With {.Descr = "Blue", .Value = Color.Blue},
New AClass With {.Descr = "Yellow", .Value = Color.Yellow}}
[...]
DLCObjects2.Items = MyArray
With the control with thousands of elements, you can see the effects of the acceleration ramp. If you want to select a near element, it's easy to select. If you want to select a far element, you have to go in a near range of this.
The effects of the selection are shown into the event interceptors:
Private Sub DLCString_CurrentIndexChanged(sender As Object, e As EventArgs) _
Handles DLCString.CurrentIndexChanged
Me.Text = DLCString.CurrentItem.ToString()
End Sub
Private Sub DLCObjects1_CurrentIndexChanged(sender As Object, e As EventArgs) _
Handles DLCObjects1.CurrentIndexChanged
Me.FormBorderStyle = CType(DLCObjects1.CurrentItem, FormBorderStyle)
End Sub
Private Sub DLCObjects2_CurrentIndexChanged(sender As Object, e As EventArgs) _
Handles DLCObjects2.CurrentIndexChanged
Me.BackColor = CType(DLCObjects2.CurrentItem, AClass).Value
End Sub
Points of Interest
It would probably be required to create the elements above and below the list as real buttons. Their representation isn't so cute. I have not focused much on them.
I wanted to create this control in WPF, but I have not been able to do so. I'd like to see how someone who was able to make it did it.
I'd like to replace the Year and the Month controls in a DateTimePicker with a control like this:
->
I don't know if it's possible (I think it's not simple if I want to split the year control into two different sections, for year and for day).
