DragListControl: 一种从列表中选择项目的全新控件
0/5 (0投票)
这是一个允许您通过单一手势从列表中选择项目的控件
引言
我想创建一个控件，为从列表中选择项目提供一种与众不同的用户体验。
背景
我通过直接继承 Control 类创建了一个新控件，并在其中插入了位图（用于显示当前项目）和弹出窗口（用于显示可滚动的元素列表）等组件。
在所选项目的上方和下方，有一个区域可以直接选择上一个或下一个项目。通过这两个区域进行项目选择时，会执行一个动画来展示正在进行的变化。
选择项目的第二种方式是，从控件上的任意点开始，向上或向下拖动鼠标。这些元素将是任何可转换为 String 类型的对象列表。
代码描述
我将代码分为三个部分：第一部分定义自定义属性和事件，第二部分处理用户交互，第三部分负责数据的表示。代码有完整的注释，（希望）易于理解。
几点说明
''' <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
我让控件的高度至少比用于渲染元素的字体高度多出50%，以便为选择上一个/下一个项目的区域留出空间。我不知道这是否是一种错误或值得商榷的方式，但这似乎是强制用户预留该空间，同时仍允许自由创建控件大小的最简单方法。
更改控件的字体会执行内部元素的缩放和最小尺寸的设置，同时通过 Me_Resize 事件重新定位内部控件并进行下一次刷新。
GotFocus 和 LostFocus 事件用于使区域无效，因为焦点正在显示。
关于属性和事件
''' <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
我尝试为属性添加了 Browsable 特性以及一个默认值，以便通过 Property 面板进行编辑。我未能为 Items 属性设置默认值。起初我将项目设置为一个 String 数组，但我意识到，如果项目可以是任何类型的对象数组（例如 statepattern），并显示其 string 表示形式，可能会更有用。这导致无法存在默认值，并且从属性面板编辑元素的难度加大（或不可能），但我认为这样更好。也许将 Items 属性设置为不可浏览会更好。
CurrentIndex 的改变会触发 CurrentIndexChanged 事件。在代码中，我对当前索引的所有引用都通过 _CurrentIndex 字段进行，但在设置它时，我使用了属性，这使得代码既快速（这是我的一个工作方法：如果 get 非常复杂，当我希望内部代码被管理时，我使用 get；否则使用字段）又智能（当我想要设置时，我希望事件被触发）。
关于用户交互
''' <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
MouseDown 事件仅用于存储鼠标点击的当前 Y 坐标位置。它还会重置拖动事件。
如果没有拖动操作，MouseUp 事件会执行选择更改。如果指针在上方区域或下方区域，它将选择上一个/下一个元素。并且会通过定时器制作的动画来显示。
在 MouseMove 中，我设置了一个阈值来判断用户是否在 PctCurrentItem_MouseMove 中执行拖动操作。
Me.PointToClient(Control.MousePosition).Y - LastMouseDownY > 5 _
OrElse Me.PointToClient(Control.MousePosition).Y - LastMouseDownY < -5
如果超过阈值，它会计算项目列表面板的位置和高度、拖动乘数（见下文）以及弹出面板的大小。然后它会显示弹出面板并启动定时器来执行操作。当弹出窗口显示时，带有项目列表的图片会被定位到其中。
我设置了一个乘数，以确保拖动不直接与鼠标移动量挂钩，而是成正比。如果总元素高度小于屏幕高度的80%（以便在一次手势中滚动整个列表），拖动和滚动的量是相同的。如果总元素高度超过屏幕高度的80%，DragMultiplier 会使整个列表在屏幕高度的80%内完成滚动。后来我意识到，如果元素非常多，直接使用乘数并不容易操作。所以我创建了 MinDragMultiplier 和 MaxDragMultiplier，它们分别是：
如果整个列表的高度小于屏幕高度80%的三倍，它们就具有该值，否则，MinDragMultiplier 的值为 3，另一个值则使得整个列表在屏幕高度的40%内完成滚动，DragMultiplier 如图表所示。
''' <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
我也可以用向上和向下方向键来选择上一个/下一个元素（它们需要被设置为输入键，否则Windows窗体会将焦点转移到上一个/下一个控件）。
在绘制过程中，按 Esc 键也可以关闭弹出窗口而不执行鼠标选择。这会在鼠标左键仍然按下的情况下进行检查。
关于渲染区域
''' <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
Tmr 定时器有两个不同的功能：如果用户选择上一个/下一个元素（通过点击上/下区域或按上/下方向键，此时 IsDragging 字段为 False），它会执行一个动画来显示选择的变化（它设置一个 AnimationStep 并使图片无效，然后 Paint 事件执行动画）；或者控制列表交互：如果鼠标左键仍然被按下，则通过上面提到的 DragMultiplier 计算实际的列表位置，而 CurrentDragYAmount 是 PctCurrentItem 中当前项目位置与 PctItemList 中要显示的当前项目位置之间的距离；如果鼠标左键不再被按下，则执行新项目的选择。
''' <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
CurrentItem 的绘制会执行动画分帧（如果动画正在运行），或者按原样显示当前项目。最后一行在控件被禁用时会执行淡出效果。
''' <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
在拖动期间，定时器会触发 ItemList 的无效化，使其看起来像一个滚动的动画。实际上，只绘制了那些在可见区域内可见的元素。
如果它能计算出要显示的最上方项目和当前位置，效率会更高，但今天我懒得弄了。:-)
最后：箭头的绘制
''' <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
以及当控件大小调整时控件的定位
''' <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
使用控件
ItemList 可以通过简单的赋值来设置。要设置闹钟的小时，您可以执行以下两种序列
DlcHour.Items = New String() {"00 am", "01 am", "02 am", [...] "11 am", "12 pm", "01 pm", .. }
或
DlcHour.Items = Enumerable.Range(0, 24).Select(Function(x As Integer) x.ToString("00")).ToArray()
设置一个 StatePattern 数组
DlcSetUp.Items = New Object () {StatePattern1, StatePattern2, StatePattern3}
要截获用户选择，您可以使用 CurrentIndexChanged 事件。
在附加的示例中，我指出了几种不同的使用该控件的方式。我用它来从一个 string 数组中选择一个元素
DLCString.Items = {"First Element", "Second Element", "Third Element", "Fourth Element"}
一个整数数组
DLCAThousand.Items = Enumerable.Range(0, 1000).ToArray()
一个格式化数字的数组
DLCMinutes.Items = Enumerable.Range(0, 60).Select(Function(x) x.ToString("00")).ToArray()
一个枚举值的数组
DLCObjects1.Items = [Enum].GetValues(GetType(FormBorderStyle))
以及一个对象数组
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
对于包含数千个元素的控件，您可以看到加速坡道的效果。如果您想选择一个附近的元素，这很容易。如果您想选择一个较远的元素，您需要先移动到一个接近它的范围内。
选择的效果在事件拦截器中显示
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
关注点
可能需要将列表上方和下方的元素创建为真正的按钮。它们的表示方式并不那么美观。我没有在它们上面花太多心思。
我本想用 WPF 来创建这个控件，但我没能做到。我很想看看有能力实现它的人是如何做到的。
我想用这样的控件替换 DateTimePicker 中的 Year 和 Month 控件。
-> 
我不知道这是否可能（如果我想将年份控件分成两个不同的部分，分别用于年和日，我认为这不简单）。