DragListControl: A New Type of Control to Select an Item from a List

• Download control - 4.6 KB
• Download example - 68.4 KB

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

''' <summary>Permits Private Components (Picture)</summary>
Private components As System.ComponentModel.IContainer

''' <summary>PictureBox Showing the current item</summary>
Private WithEvents PctCurrentItem As System.Windows.Forms.PictureBox
''' <summary>PictureBox Showing the List during the drag</summary>
Private WithEvents PctItemList As System.Windows.Forms.PictureBox
''' <summary>Popup Window showing the list</summary>
Private WithEvents PopUpD As ToolStripDropDown
''' <summary>ControlHost of PopUp Containing the PctItemList</summary>
Private PopUpHost As ToolStripControlHost
''' <summary>Timer: If the DragDrop is open: Permit the list refresh checking
''' for the mouse position. If the DragDrop is closed,
''' it performs the Current shifting</summary>
Private WithEvents Tmr As New Timer With {.Interval = 10}

''' <summary>Initializing</summary>
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

''' <summary>Change of the font: resize the picture of current item,
''' Constraint the minimum size</summary>
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

''' <summary>Permits the focus repainting</summary>
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

''' <summary>CurrentIndexChanged</summary>
Public Event CurrentIndexChanged(sender As Object, e As EventArgs)

''' <summary>Width of arrows</summary>
Private _ArrowWidth As Single = 1
''' <summary>Width of arrows</summary>
<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

''' <summary>Color of arrows</summary>
Private _ArrowColor As Color = Color.DarkGray
''' <summary>Color of arrows</summary>
<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

''' <summary>Item List</summary>
Private Property _Items As Array = New Object() {}
''' <summary>Item List</summary>
''' <remarks>DefaultValueAttribute is not settable
''' (An empty Array is always different from another empty array)</remarks>
<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

''' <summary>Index of Current Item</summary>
Private _CurrentIndex As Integer = 0
''' <summary>Index of Current Item</summary>
<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
''' <summary>Text of Current Item</summary>
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

''' <summary>Store the Y coordinate of Mouse Down
''' (to recognize if it's a drag or a click)</summary>
Private LastMouseDownY As Integer
''' <summary>The control is performing a drag selection</summary>
Private IsDragging As Boolean
''' <summary>Store the Y coordinate of Start of the Drag Action
''' (it different from LastMouseDownY: there is a threshold)</summary>
Private StartDragYLocation As Integer
''' <summary>Multiplier minimum of the Drag Action:
''' it's value is for the 25% of the screen height, its maximum value is 3,
''' it's minimum value is 1</summary>
Private MinDragMultiplier As Single
''' <summary>Multiplier maximum of the Drag Action:
''' its value makes the drag of the all screen height is
''' over the all list scrolling</summary>
Private MaxDragMultiplier As Single
''' <summary>Shift amount of the Drag</summary>
Private CurrentDragYAmount As Integer
''' <summary>Current Picture Top: I don't know if the action is
''' started from the picture, from the entire control.
''' I store the location of the control into the screen</summary>
Private PictureContentCurrentTop As Integer
''' <summary>List Picture Top: I don't know if the action is started from the picture,
''' from the entire control. I store the location of the control into the screen
''' </summary>
Private PictureListCurrentTop As Integer
''' <summary>Number of elements into the drag panel</summary>
Private MaxItemCountHeightInPanel As Integer = 7

''' <summary>Mouse down: Store the current Y</summary>
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
    'in any case: switch off the popup
    IsDragging = False
    If PopUpD.Visible Then PopUpD.Close()
End Sub
''' <summary>MouseUp: If I'm not dragging, select the previous or next element</summary>
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
        ' Start the animation
        AnimationStartTime = Now
        Tmr_Tick(Nothing, Nothing)
    End If
End Sub
''' <summary>If I'm out of the threshold, performs dragging start
''' (show the popup)</summary>
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
        ' Drag start: Shows the panel, with a maximum height as the 80% of the
        ' screen height, with 7 elements (if the item has seven elements)
        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

        ' Set the multiplier if the screen is too short
        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

        ' set the popup
        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)

        ' Show the popup
        PopUpD.Show(Me.PointToScreen(New Point(0, 0)).X - 1, CInt(PictureListCurrentTop))
        Tmr.Start()
    End If
End Sub
''' <summary>Set the location after the show
''' (elsewhere, the PctItemList is a pixel downer)</summary>
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:

''' <summary>Permits to use Up and Down keys to select the previous/next element</summary>
''' <param name="KeyData">Up and Down keys</param>
''' <returns>True</returns>
Protected Overrides Function IsInputKey(KeyData As Keys) As Boolean
    Return KeyData = Keys.Escape OrElse KeyData = Keys.Up OrElse KeyData = Keys.Down
End Function
''' <summary>Esc: Disable the dragging popup - Up/Down arrows:
''' Select the Previous/Next element</summary>
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

''' <summary>DateTime of the start of the animation</summary>
Private AnimationStartTime As Date
''' <summary>Animation Direction (True: Up - False: Down)</summary>
Private AnimationDirectionIsUp As Boolean
''' <summary>Actual  Step of the animation (0-1)</summary>
Private AnimationStep As Single
''' <summary>Timer: If the DragDrop is open:
''' Performs the list refresh checking for the mouse position.
''' If the DragDrop is closed, it performs the Current shifting</summary>
Private Sub Tmr_Tick(sender As Object, e As EventArgs) Handles Tmr.Tick
    If IsDragging Then
        If Control.MouseButtons = Windows.Forms.MouseButtons.Left Then
            ' It's still dragging
            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
            ' Stop to drag. Calculates the new Current Index and close the popup
            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
        ' It's animating
        Dim TmpAnimationStep As Single = CSng((Now - AnimationStartTime).TotalSeconds * 4)
        If TmpAnimationStep >= 1 Then
            ' End of animation
            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.

''' <summary>If there is an animation: paint the current element and the previous
''' (if the animation is to the next) or the next (if the animation is to the previous)
''' </summary>
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
            ' No animations: draw the current element
            e.Graphics.DrawString(Str, PctCurrentItem.Font, _
                 New SolidBrush(Me.ForeColor), _
                 CInt(PctCurrentItem.Width / 2 - SizeStr.Width / 2), 1)
        Else
            ' Animations: Draw two elements
            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.

''' <summary>Draw the list of all items. It's made two times
''' (if the list is to draw from one of latest) according to the animation</summary>
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:

''' <summary>Draw arrow buttons</summary>
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:

''' <summary>Resize the picture of the current item</summary>
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).