DragListControl:一种新类型的控件，用于从列表中选择项

• 下载control - 4.6 KB
• 下载example  - 68.4 KB

介绍 我想创建一个控件来为从列表中选择项提供不同于通常的用户体验。 背景 通过直接继承控件类，并在其中插入位图(用于显示当前项)和弹出框(用于显示可滚动的元素列表)，我创建了一个新控件。 所选项目的上面和下面是一个区域，可以直接选择上一个或下一个项目。项目选择由两个区域完成，执行动画显示变化执行: 选择项的第二种方法是从控件上的任何点开始向上或向下拖动鼠标。元素将是可转换为字符串的任何类型的对象的列表: 代码描述 我将代码分为三个部分:第一部分用于定义自定义属性和事件，第二部分用于用户交互，第三部分用于数据的表示。代码被完全注释并且(希望)容易理解。 一些笔记 隐藏,收缩,复制Code

''' <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事件将使该区域无效，因为焦点正在显示。 关于属性和事件 隐藏,收缩,复制Code

''' <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属性和一个默认值，以允许通过属性面板进行编辑。我不能把一个默认值的项目属性。我第一次将项目作为字符串数组放入，但我意识到，如果项目可以是任何类型对象(例如statepattern)的数组，并显示字符串表示，那么它可能更有用。这使得默认值不存在，并且属性面板中的元素更难(或不可能)可编辑性，但我认为这样更好。如果项目属性是不可浏览的，可能会更好。 CurrentIndex的变化引发了currentindexchangeevent。我做了所有引用当前指数代码通过_CurrentIndex字段,但是当它将,我使用属性使代码快(我工作的方法:如果是如此棘手,我使用内部代码的得到我想要的是管理,我使用了字段时)和智能(当我想要,我想要提出的事件)。 对用户交互 隐藏,收缩,复制Code

''' <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

鼠标向下只存储鼠标单击的当前Y位置。它还重置了拖动事件。 如果没有拖动，则鼠标向上执行更改选择。如果指针指向上区域或下区域，它将被选择上一个/下一个元素。它会通过定时器制作的动画来显示。 在MouseMove中，我设置了一个阈值，看看用户是否在执行拖拽到PctCurrentItem_MouseMove: 隐藏,复制Code

Me.PointToClient(Control.MousePosition).Y - LastMouseDownY > 5 _
     OrElse Me.PointToClient(Control.MousePosition).Y - LastMouseDownY < -5

如果通过了阈值，它将计算项目列表面板的位置和高度、拖动倍率(见下面)以及弹出面板的大小。然后它显示弹出面板，并让计时器开始执行操作。当弹出窗口显示时，带有项目列表的图片被放置在其中。 我使用了一个倍增器，以确保拖动不会直接增加鼠标移动量，但这是直接成比例的。如果元素的总高度小于屏幕高度的80%(在一个手势中滚动整个列表)，则拖动和滚动的量是相同的。如果元素的总高度大于屏幕高度的80%，则拖拽倍增器将把所有列表滚动到屏幕高度的80%。第二次，我意识到如果元素真的很多，直接乘法器不是很容易使用。所以我创建了一个MinDragMultiplier和一个MaxDragMultiplier，它们分别是: 如果整个列表的大小高度的3倍少80%屏幕高度,他们有价值,在其他地方,MinDragMultiplier值为3,另一个执行整个滚动列表的值为40%的屏幕高度,让DragMultiplier像图: 隐藏,复制Code

''' <summary>Permits to use Up and Down keys to select the previous/next element</summary>
''' <paramname="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

我还可以用向上和向下键箭头来选择上一个/下一个元素(它们被设置为输入键，在其他地方窗口窗体执行焦点以转到上一个/下一个控件) 此外，Esc键执行关闭弹出窗口，而不执行鼠标选择在绘图期间。当鼠标左键仍在按下时，它将被检查。 关于渲染区域 隐藏,收缩,复制Code

''' <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

咯定时器有两个不同的功能:如果用户选择前一个/下一个元素(通过点击进入上/下区域或通过按上下键箭头,IsDragging字段是假的),它执行一个动画显示选择改变(设置一个AnimationStep和失效的图片,然后油漆事件执行动画)或控件交互列表:如果鼠标左键仍压,计算实际的列表位置通过DragMultiplier如上所示,CurrentDragYAmount是当前项之间的距离位置PctCurrentItem和当前项位置显示PctItemList,如果鼠标不是仍然按下,执行新项目选择。 隐藏,收缩,复制Code

''' <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的绘制执行动画帧(如果动画正在运行)，或者显示当前项。如果控件被禁用，最后一行将执行衰落。 隐藏,收缩,复制Code

''' <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失效，看起来像是滚动的动画。实际上，只绘制那些在可见区域可见的元素。 如果它计算上面的项来显示和当前位置会更有效率，但是今天我很懒。: -) 最后:箭画: 隐藏,复制Code

''' <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

和控制定位时，会有一个大小调整: 隐藏,复制Code

''' <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可以通过一个简单的赋值设置。设置闹钟的时间，你可以做两种序列: 隐藏,复制Code

DlcHour.Items = New String() {"00 am", "01 am", "02 am", [...] "11 am", "12 pm", "01 pm", .. }

或者: 隐藏,复制Code

DlcHour.Items = Enumerable.Range(0, 24).Select(Function(x As Integer) x.ToString("00")).ToArray()

设置StatePattern数组: 隐藏,复制Code

DlcSetUp.Items = New Object () {StatePattern1, StatePattern2, StatePattern3}

要拦截用户选择，可以使用currentindexchangeevent。 在附加的示例中，我指出了使用该控件的一些不同方法。我用它从字符串数组中选择一个元素: 隐藏,复制Code

DLCString.Items = {"First Element", "Second Element", "Third Element", "Fourth Element"}

一个整数数组: 隐藏,复制Code

DLCAThousand.Items = Enumerable.Range(0, 1000).ToArray()

格式化数字数组: 隐藏,复制Code

DLCMinutes.Items = Enumerable.Range(0, 60).Select(Function(x) x.ToString("00")).ToArray()

枚举值数组: 隐藏,复制Code

DLCObjects1.Items = [Enum].GetValues(GetType(FormBorderStyle))

和一个对象数组: 隐藏,复制Code

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

有数千个元素的控制，你可以看到加速度斜坡的效果。如果您想选择一个near元素，选择起来很容易。如果你想选择一个远的元素，你必须在这个近的范围内。 选择的效果会显示在事件拦截器中: 隐藏,复制Code

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控件替换年和月像这样的控件: → 我不知道这是否可能(我认为如果我想把年度控制分成两个不同的部分，一年和一天，那就不简单了)。 本文转载于：http://www.diyabc.com/frontweb/news360.html