gTrackBar - 一个自定义 TrackBar 用户控件 (VB.NET)

引言

我一定有强迫症（Obsessive Control Disorder）。标准的 TrackBar 控件烦扰我很久了，但我一直忍到现在。我终于厌倦了它乏味的外观，以及必须为它编写一个 TextBox 或 Label 来显示数值，还有一个 Label 用来说明它的用途。所以，这就是我需要的 TrackBar，希望它对你也有帮助。由于属性太多，无法像我通常那样一一列出，所以我决定列出属性组的功能，并附上整个列表的截图。

1. Control 组包含了控件的 Border（边框）、Value（值）和 Orientation（方向）属性。
2. FloatValue 是用鼠标移动滑块时显示的值。
3. Label 是出现在 TrackBar 上方的文本。
4. Slider 是指滑轨、刻度线和滑块按钮本身。
5. UpDownButtons 是位于 TrackBar 两端的按钮，用于将数值加一或减一。
6. ValueBox 是显示数值的框。

属性

Building 区域包含了根据设置的属性来配置控件所有部分的布局、大小和位置的例程。

绘制

重写 Paint 事件，以自定义方式在正确的位置用正确的方向绘制控件的每个部分。

Protected Overrides Sub OnPaint(ByVal e As System.Windows.Forms.PaintEventArgs)

    MyBase.OnPaint(e)

    'Setup the Graphics
    Dim g As Graphics = e.Graphics
    g.SmoothingMode = SmoothingMode.AntiAlias
    g.TextRenderingHint = Drawing.Text.TextRenderingHint.AntiAlias

    'Draw a Border around the control if requested
    If _BorderShow Then
        g.DrawRectangle(New Pen(_BorderColor), _
            0, 0, Me.Width - 1, Me.Height - 1)
    End If

    'Add the value increment buttons if requested
    If _UpDownShow Then DrawUpDnButtons(g)
        'Add the Line and Tick Marks
        DrawSliderLine(g)

    'Draw the Label Text if requested
    If _LabelShow Then
        DrawLabel(g)
        'g.DrawRectangle(Pens.Gray, rectLabel)
    End If

    'Add the Slider button
    DrawSlider(g)

    'Draw the Value above the Slider if requested
    If _FloatValue AndAlso IsOverSlider AndAlso _
      MouseState = eMouseState.Down Then
        DrawFloatValue(g)
    End If

    'Draw the Box displaying the value if requested
    If Not _ValueBox = eValueBox.None Then
        DrawValueBox(g)
    End If

    'Draw Focus Rectangle around control if requested 
    If _ShowFocus AndAlso Me.Focused Then
        ControlPaint.DrawFocusRectangle(g, New Rectangle( _
        2 + CInt(Not _BorderShow), 2 + CInt(Not _BorderShow), _
        Me.Width - ((2 + CInt(Not _BorderShow)) * 2), _
        Me.Height - ((2 + CInt(Not _BorderShow)) * 2)), _
        Color.Black, Me.BackColor)
    End If
End Sub

我使用了基本的 GDI+ 函数来绘制控件的每个部分。我将重点介绍一些比较精彩的部分。

在 DrawUpDnButtons 中，我基本上需要根据 Orientation（方向）和按钮在控件的哪一侧，以四种方式之一来绘制一个按钮。按钮本身只是一个带有渐变色填充的矩形。技巧在于箭头。我本可以计算每个箭头的位置和点来为每个箭头创建一个单独的 GraphicsPath，但我使用了一个 Matrix 来 Rotate（旋转）和/或 Translate（平移）一个简单的 GraphicsPath 到正确的位置。

首先设置三个点，并在它们之间添加一条线，以创建三角形箭头 ^ 的形状。

Dim gp As New GraphicsPath
Dim pts() As Point
Dim mx As New Matrix

pts = New Point() { _
        New Point(5, 0), _
        New Point(0, 5), _
        New Point(5, 10)}
gp.AddLines(pts)

对于左侧按钮，GraphicsPath 的方向是正确的，所以只需将其平移（移动）到按钮矩形内的正确位置。

With rectDownButton

    mx.Translate(5, CSng((rectDownButton.Y _
      + (rectDownButton.Height / 2)) - 6))
    gp.Transform(mx)
    g.DrawPath(pn, gp)

End With

对于右侧按钮，GraphicsPath 需要翻转，但没有内置的翻转函数。可以使用 New Matrix(-1, 0, 0, 1, 此处为图像宽度, 0) 来水平翻转 GraphicsPath。

With rectUpButton
     mx = New Matrix(-1, 0, 0, 1, 5, 0)
     mx.Translate(.X + 9, 0, MatrixOrder.Append)
     gp.Transform(mx)
     g.DrawPath(pn, gp)
End With

对于上方按钮，GraphicsPath 需要旋转90度。找到中心点，并围绕该点进行 RotateAt 旋转。

With rectDownButton

     mx.RotateAt(90, New PointF(gp.GetBounds.Width / 2, _
         gp.GetBounds.Height / 2))

     mx.Translate(CSng((rectDownButton.X + _
        (rectDownButton.Width / 2)) - 3), 4, MatrixOrder.Append)

     gp.Transform(mx)
     g.DrawPath(pn, gp)
End With

对于下方按钮，GraphicsPath 需要再次翻转。可以使用 New Matrix(1, 0, 0, -1, 0, 此处为图像高度) 来垂直翻转图像。

With rectUpButton
     mx = New Matrix(1, 0, 0, -1, 0, 10)
     mx.Translate(0, .Y + 6, MatrixOrder.Append)
     gp.Transform(mx)
     g.DrawPath(pn, gp)
End With

自定义类型转换器

滑块画刷中使用的 CenterPoint 和 FocusScales 是 PointF 类型。当你创建一个 PointF 类型的新属性时，你会注意到它在 PropertyGrid 中是灰色的，但如果一个属性是 Point 类型，它就可以在 PropertyGrid 中正常编辑。问题在于没有内置的 PointF 类型转换器（TypeConverter）。这个问题其实很容易解决。

一个没有自定义 TypeConverter 的 PointF 类型属性：它在代码中可以工作，但你无法在 PropertyGrid 中编辑它。

有了 PointFConverter，它在 PropertyGrid 中的表现就和 Point 属性一样了。

创建一个属性并添加 TypeConverter 特性，引用我们即将添加的 PointFConverter 类。

Private _SliderHighlightPt As PointF = New PointF(-5.0F, -2.5F)
<Category("Appearance Slider")> _
<Description("Point on the Slider for the Highlight Color")> _
<TypeConverter(GetType(PointFConverter))> _
Public Property SliderHighlightPt() As PointF
    Get
        Return _SliderHighlightPt
    End Get
    Set(ByVal value As PointF)
        _SliderHighlightPt = value
        Me.Invalidate()
    End Set
End Property

PointFConverter 类继承自 ExpandableObjectConverter，并重写了 CanConvertFrom、ConvertFrom 和 ConvertTo 函数。

Friend Class PointFConverter : Inherits ExpandableObjectConverter

    Public Overloads Overrides Function CanConvertFrom( _
        ByVal context As System.ComponentModel.ITypeDescriptorContext, _
        ByVal sourceType As System.Type) As Boolean

        If (sourceType Is GetType(String)) Then
            Return True
        End If
        Return MyBase.CanConvertFrom(context, sourceType)
    End Function

    Public Overloads Overrides Function ConvertFrom( _
        ByVal context As System.ComponentModel.ITypeDescriptorContext, _
        ByVal culture As System.Globalization.CultureInfo, _
        ByVal value As Object) As Object

        If TypeOf value Is String Then
            Try
                Dim s As String = CType(value, String)
                Dim ConverterParts(2) As String
                ConverterParts = Split(s, ",")
                If Not IsNothing(ConverterParts) Then
                    If IsNothing(ConverterParts(0)) Then ConverterParts(0) = "-5"
                    If IsNothing(ConverterParts(1)) Then ConverterParts(1) = "-2.5"
                    Return New PointF(CSng(ConverterParts(0).Trim), _
                                      CSng(ConverterParts(1).Trim))
                End If
            Catch ex As Exception
                Throw New ArgumentException("Can not convert '" & _
                    CStr(value) & "' to type Corners")
            End Try
        Else
            Return New PointF(-5.0F, -2.5F)
        End If

        Return MyBase.ConvertFrom(context, culture, value)
    End Function


    Public Overloads Overrides Function ConvertTo( _
        ByVal context As System.ComponentModel.ITypeDescriptorContext, _
        ByVal culture As System.Globalization.CultureInfo, _
        ByVal value As Object, ByVal destinationType As System.Type) As Object

        If (destinationType Is GetType(System.String) _
            AndAlso TypeOf value Is PointF) Then

            Dim ConverterProperty As PointF = CType(value, PointF)
            ' build the string representation 
            Return String.Format("{0}, {1}", _
                    ConverterProperty.X, _
                    ConverterProperty.Y)
        End If
        Return MyBase.ConvertTo(context, culture, value, destinationType)
    End Function
End Class 'PointFConverter Class

自定义颜色类型转换器

 

有时对于自定义控件，属性可能会变得有点难以管理。这个控件有很多颜色选项，其中一些有重复的模式。例如，滑块按钮有三种状态和三个属性（Face、Border 和 Highlight）。与其在一长串令人困惑的属性中列出九种颜色，不如将它们分组为三个可展开的属性，每个属性下有三个子属性。ColorPack 类和 TypeConverter 用于三种滑块状态属性。ColorLinearGradient 类和 TypeConveter 用于滑块轨道的线性渐变属性。这使得 PropertyGrid 看起来更整洁，更易于阅读。

鼠标事件

这里我们检查光标悬停在控件的哪个部分，以及鼠标按钮是否被按下。根据这些信息，相应地调整 Value。

因为 MouseDown、Click 等事件只触发一次，所以需要一个 Timer 来检查鼠标是否仍然按下，如果是，则再次更改数值。我不希望它一点即跑，所以在鼠标点击后有一个内置的延迟，延迟过后它才开始递增数值。另一个问题是，如果最大/最小值范围很大，它会爬得非常慢，而小范围则会过快，所以 Timer 的间隔会根据范围的大小进行调整。

Private Sub MouseTimer_Tick(ByVal sender As Object, _
    ByVal e As System.EventArgs) Handles MouseTimer.Tick

    'Check if mouse was just clicked
    If MouseHoldDownTicker < 5 Then
        MouseHoldDownTicker += 1
        'Interval was set to 100 on MouseDown
        'Tick off 5 times and then reset the Timer Interval
        '  based on the Min/Max span
        If MouseHoldDownTicker = 5 Then
            MouseTimer.Interval = CInt(Math.Max _
                (10, 100 - ((_MaxValue - _MinValue) / 10)))
        End If
    Else
        'Change the value until the mouse is released
        OldValue = _Value
        Value += MouseHoldDownChange
        RaiseEvent Scroll(Me, New ScrollEventArgs( ScrollType, oldValue, 
                          _Value, CType(Me.Orientation, ScrollOrientation)))
    End If
End Sub

按键事件

我希望能够通过按箭头键来调整 Value。这听起来很简单。我想我只需在 KeyUp 事件中检查 e.KeyValue 并相应地调整 Value 就行了。嗯，没那么简单。问题在于 UserControl 继承自 Button，而后者会自动以不同的方式处理箭头键。在 KeyUp 事件之后，焦点会跳转到 Tab 顺序中的下一个控件，即使你使用了 e.Handled 和 e.SuppressKeyPress。我无法阻止焦点改变。然后，我想我可以使用 KeyDown 事件，但你猜怎么着，箭头键在那里被自动忽略了。为了解决这个问题，我重写了 IsInputKey 函数以允许箭头键。这样之后，焦点就不会再跳走了。

Protected Overrides Function IsInputKey( _
          ByVal keyData As System.Windows.Forms.Keys) As Boolean

    'Because a Usercontrol ignores the arrows in the KeyDown Event
    'and changes focus no matter what in the KeyUp Event
    'This is needed to fix the KeyDown problem
    Select Case keyData And Keys.KeyCode
        Case Keys.Up, Keys.Down, Keys.Right, Keys.Left
            Return True
        Case Else
            Return MyBase.IsInputKey(keyData)
    End Select
End Function

Private Sub gTrackBar_KeyUp(ByVal sender As Object, _
            ByVal e As System.Windows.Forms.KeyEventArgs) Handles Me.KeyUp
  
    OldValue = _Value

    Dim adjust As Integer = _ChangeSmall
    If e.Shift Then
        adjust = _ChangeLarge
    End If

    Select Case e.KeyValue
        Case Keys.Up, Keys.Right
            Value += adjust
            If e.Shift Then
                ScrollType = ScrollEventType.LargeIncrement
            Else
                ScrollType = ScrollEventType.SmallIncrement
            End If

        Case Keys.Down, Keys.Left
            Value -= adjust
            If e.Shift Then
                ScrollType = ScrollEventType.LargeDecrement
            Else
                ScrollType = ScrollEventType.SmallDecrement
            End If
    End Select
    RaiseEvent Scroll(Me, New ScrollEventArgs(ScrollType, OldValue, 
                      _Value, CType(Me.Orientation, ScrollOrientation)))

End Sub

历史

• 1.0 版 - 2009年3月
• 1.2 版 - 2009年4月
  • 添加了焦点矩形
  • 将标签分离到其自己的矩形区域，以获得更好的布局和尺寸调整
  • 常规布局修复
• 1.3 版 - 2009年4月
  • 处理负数范围
• 1.4 版 - 2010年7月
  • 添加了图像滑块
  • 添加了 UpDownShow 以隐藏和关闭上/下按钮
  • 为更改数值添加了 Timer（在短暂延迟后），直到鼠标释放
• 1.5 版 - 2011年7月
  • 添加了 JumpToMouse 功能
  • 修复了显示标签时刻度对齐的问题
  • 添加了 SnapToValue 属性
• 1.6 版 - 2011年9月
  • 添加了 ValueDivisor 和 ValueAdjusted 以支持小数值
  • 修复了当最小值大于0时垂直版本的问题
• 1.7 版 - 2012年2月
  • 将 Up、Down 和 Hover 颜色属性合并到单独的 ColorPack 类中
  • 为属性添加了默认值
• 1.8 版 - 2012年4月
  • ColorLinearGradient 类用于为滑块轨道着色
  • 修复了一些布局错误
  • 添加了 TickThickness 和 TickOffset 属性
• 1.9 版 - 2015年3月
  • 添加了 Scroll Event（滚动事件）。许多人要求提供滚动事件。当我最初创建这个控件时，ValueChanged Event（值改变事件）已经满足了我的所有需求，但我对此感到好奇，所以就加上了。
  • 添加了MouseWheel（鼠标滚轮）支持。