gTimePicker - 可选时间值的控件 (VB.NET)

• 下载源代码 - 85.95 KB

引言

我再也无法忍受标准的 DateTimePicker 的时间部分了。我想要一个易于使用的日期下拉列表和一个不存在的时间下拉列表。首先，我创建了 gTimePickerCntrl，用户只需点击几下即可使用类似时钟的界面选择时间。其次，我需要一个包含它的下拉控件。第三，作为开发者，我需要额外的设计时支持。

在创建了 gTimePicker 之后，我意识到我需要一个与之配套的可为空的 DateTimePicker。现在，我已经添加了 gDateTimePicker，并为 gTimePicker 添加了可空功能。

如何使用 gTimePickerCtrl

很简单 -
点击内圈的数字选择小时。
点击外圈的数字选择分钟。

控件属性

以下是主要属性列表

• Public Property Time() As String

  获取或设置时间值

• Public Property TimeAMPM() As eTimeAMPM

  获取或设置 AM PM 值

• Public Property Hr24() As Boolean

  获取或设置时间为 12 小时制或 24 小时制

• Public Property TrueHour() As Boolean

  获取或设置时针是否显示真实时钟位置，还是保持指向所选小时，而忽略分钟

• Public Property TimeColors() As TimeColors

  获取或设置控件的配色方案

Paint

起初，我有一个带有背景图像的时钟面，并在其上方绘制了指针，但后来我被该图像的颜色困住了。为了使其更具动态性，我使用简单的 PathGradientBrush 绘制了框架，以营造 3D 框架的错觉。

Sub DrawClockFace(ByRef g As Graphics, ByVal rect As Rectangle)

    'Simple Breakdown of creating a ColorBlend from scratch
    g.SmoothingMode = SmoothingMode.AntiAlias

    Dim blend As ColorBlend = New ColorBlend()

    'Add the Array of Color
    Dim bColors As Color() = New Color() { _
        TimeColors.FrameOuter, _
        TimeColors.FrameInner, _
        TimeColors.FrameOuter, _
        TimeColors.FaceOuter, _
        TimeColors.FaceInner}
    blend.Colors = bColors

    'Add the Array Single (0-1) colorpoints to place each Color
    Dim bPts As Single() = New Single() { _
        0, _
        0.0408, _
        0.082, _
        0.109, _
        1}
    blend.Positions = bPts

    ' Create a PathGradientBrush
    Dim gp As New GraphicsPath
    gp.AddEllipse(rect)
    Using br As New PathGradientBrush(gp)

        'Blend the colors into the Brush
        br.InterpolationColors = blend

        'Fill the rect with the blend
        g.FillEllipse(br, rect)

    End Using
    gp.Dispose()
End Sub

要在时钟上绘制指针，您需要计算时钟周围的点。

...
Dim HourAngle As Single = 90 - (CSng(30 * (Val(_Time.Substring(0, 2))) + _
    CSng(IIf(TrueHour, Val(_Time.Substring(3, 2)) / 2, 0))))
Dim MinAngle As Single = 90 - CSng(6 * Val(_Time.Substring(3, 2)))

e.Graphics.DrawLine(HrPen, Center, GetPoint(Center, 35, HourAngle))
e.Graphics.DrawLine(MinPen, Center, GetPoint(Center, 60, MinAngle))

...

Public Function GetPoint(ByVal ptCenter As Point, ByVal nRadius As Integer, _
       ByVal fAngle As Single) As Point

    Dim x As Single = CSng(Math.Cos(2 * Math.PI * fAngle / 360)) * nRadius + ptCenter.X
      Dim y As Single = -CSng(Math.Sin(2 * Math.PI * fAngle / 360)) * nRadius + ptCenter.Y

    Return New Point(CInt(Fix(x)), CInt(Fix(y)))

End Function

在 Time 属性中，会对值进行验证，包括一些正则表达式匹配。

接受的值包括 07:00、800、4、0900p、4:00 A... 等。

   Public Property Time() As String
        Get
            Return _Time
        End Get
        Set(ByVal value As String)
            Dim tTime As String = _Time

            If Not IsNothing(value) And value <> String.Empty Then

                'Check if value is just the hour
                If Regex.IsMatch(value, _
                   "^[0-9]{1}$|^[0-1]{1}[0-9]{1}$|^[2]{1}[0-3]{1}$") Then
                    value = value & ":00"
                End If

                Dim ap As eTimeAMPM

                If Hr24 Then
                    If Val(value.Replace(":", String.Empty)) >= 1200 Then
                        ap = eTimeAMPM.PM
                    Else
                        ap = eTimeAMPM.AM
                    End If
                    value = Format(Val(value.Replace(":", String.Empty)), "0000")
                Else
                    ap = _TimeAMPM

                    'Check if a P, PM, A or AM is on the End
                    'Update TimeAMPM Prop and remove from value
                    If value.ToUpper.EndsWith("P") Or value.ToUpper.EndsWith("PM") Then
                        value = value.ToUpper.Trim(CChar("M")).Trim(CChar("P")).Trim
                        ap = eTimeAMPM.PM
                    ElseIf value.ToUpper.EndsWith("A") _
            Or value.ToUpper.EndsWith("AM") Then
                        value = value.ToUpper.Trim(CChar("M")).Trim(CChar("A")).Trim
                        ap = eTimeAMPM.AM
                    End If
                End If

                'Check if value is a valid time with or without a colon
                If Regex.IsMatch_
        (value, "^(([0-9])|([0-1][0-9])|([2][0-3])):?([0-5][0-9])$") Then
                    'Check and add leading '0'
                    If Regex.IsMatch_
            (value, "^(([0-9])):?([0-5][0-9])$") Then value = "0" & value
                    'Add a Colon if missing
                    If Regex.IsMatch_
            (value, "^(([0-1][0-9])|([2][0-3]))([0-5][0-9])$") Then
                        _Time = String.Format("{0}:{1}", value.Substring(0, 2), _
                            value.Substring(2, 2))
                    Else
                        _Time = value
                    End If

                    If Not IsNothing(ap) Then TimeAMPM = ap

                    'Adjust for 12 or 24 hour time
                    If Hr24 Then
                        If Hour() >= 12 Then
                            TimeAMPM = eTimeAMPM.PM
                        Else
                            TimeAMPM = eTimeAMPM.AM
                        End If
                    Else
                        If Hour() > 12 Then
                            _Time = String.Format("{0:0#}:{1:0#}", _
                                Hour() - 12, Minute)
                            TimeAMPM = eTimeAMPM.PM
                        ElseIf Hour() = 0 Then
                            _Time = String.Format("12:{0:0#}", Minute)

                        End If

                    End If
                End If

            Else
                _Time = String.Empty

            End If
            If tTime <> _Time Then RaiseEvent TimePicked(Me)

            Invalidate()
        End Set
    End Property

从鼠标位置获取时间

MouseDown 事件通过计算鼠标与中心的距离来确定鼠标是在小时环还是分钟环内。

    Private Sub gTimePickerCntrl_MouseDown(ByVal sender As Object, _
      ByVal e As MouseEventArgs) Handles Me.MouseDown

        'Determine how far from center
        Dim radius As Integer = CInt( _
            Math.Round( _
            Math.Sqrt( _
                Math.Pow(CDbl(Center.X - e.Location.X), 2) + _
                Math.Pow(CDbl(Center.Y - e.Location.Y), 2)) _
                , 2))
        If radius <= 55 Then
            IsHourRadius = True
        Else
            IsHourRadius = False
        End If
        UpdateTime(e)

    End Sub

然后，在 Sub UpdateTime 中使用 GetAngle 函数来计算它位于哪个数字上方。

    Private Shared Function GetAngle(ByVal Origin As PointF, _
                                ByVal XYPoint As PointF) As Integer

        Dim angleRadians As Double = Math.Atan2( _
                                        (-(XYPoint.Y - Origin.Y)), _
                                        ((XYPoint.X - Origin.X)))
        Dim translatedAngle As Integer
        Dim angle As Integer = CInt(Math.Round(angleRadians * (180 / Math.PI)))

        'Translate to orient o degrees to the North
        If angle <= 90 Then
            translatedAngle = 90 - angle
        Else
            translatedAngle = 450 - angle
        End If

        Return translatedAngle

    End Function

gTimePicker 下拉控件

gTimePicker 是一个简单的下拉用户控件，用于包含 gTimePickerCntrl。我使用了一个扩展的 TextBox 并手动绘制了按钮。gTimePickerCntrl 被托管在 ToolstripDropDown 中。

事件

• Public Event TimePicked(ByVal sender As Object)

  当时间更改时，将触发此事件。

初始化

要设置 ToolStripDropDown，首先将 gTimePickerCntrl 放入 ToolStripControlHost。

host = New ToolStripControlHost(gTime)

然后，将 ToolStripControlHost 添加到 ToolStripDropDown。

popup.Items.Add(host)

这是完整的 Sub，包括添加的事件处理程序

Private gTime As New gTimePickerCntrl

Private Sub gTimePicker_Load(ByVal sender As Object, _
            ByVal e As System.EventArgs) Handles Me.Load

    host = New ToolStripControlHost(gTime)

    host.Margin = Padding.Empty
    host.Padding = Padding.Empty
    host.AutoSize = False
    host.Size = gTime.Size

    popup.Size = gTime.Size
    popup.Items.Add(host)

    AddHandler popup.Closed, AddressOf popup_Closed
    AddHandler popup.Closing, AddressOf popup_Closing
    txbTime.Text = _Time
    Clear.Items.Add("Clear Time")
    Me.ContextMenuStrip = Clear

End Sub

控件属性

匹配的 gTimePickerCntrl 属性获取或设置相应的 TimePickerCntrl 值。以下是附加属性列表：

• Public Property TimeAMPM() As eTimeAMPM

  获取或设置 AM PM 值

• Public Property Hr24() As Boolean

  获取或设置时间为 12 小时制或 24 小时制

• Public Property TrueHour() As Boolean

  获取或设置时针是否显示真实时钟位置，还是保持指向所选小时，而忽略分钟

• Public Property TimeColors() As TimeColors

  获取或设置控件的配色方案

• Public Property TextBackColor() As Color

  获取或设置文本的背景颜色

• Public Property TextForeColor() As Color

  获取或设置文本的前景色

• Public Property TextAlign() As HorizontalAlignment

  获取或设置文本的水平对齐方式

• Public Property TextFont() As Font

  获取或设置文本框的字体

• Public Property ButtonForeColor() As Color

  获取或设置下拉按钮上箭头的颜色

• Public Property ButtonBackColor() As Color

  获取或设置下拉按钮的基本颜色

• Public Property ButtonHighlight() As Color

  获取或设置下拉按钮的高亮颜色

• Public Property ButtonBorder() As Color

  获取或设置下拉按钮的边框颜色

• Public Property NullText() As String

  显示 NULL 时的文本

• Public Property NullTextInFront() As Boolean

  NULL 文本是否应显示在填充图案的前面

• Public Property NullTextColor() As Color

  NULL 文本的颜色

• Public Property NullHatchStyle() As HatchStyle

  选择 HatchStyle

• Public Property NullColorA() As Color

  HatchStyle 的颜色 A

• Public Property NullColorB() As Color

  HatchStyle 的颜色 B

• Public Property NullAlpha() As Integer

  HatchStyle 的 Alpha 值，以便您可以看到其中的 NULL 文本

方法

• Public Function ToStringAMPM() As String

  返回 _Time & " " & _TimeAMPM.ToString

• Public Function ToDate() As DateTime

  返回 CDate(_Time & " " & _TimeAMPM.ToString)

• Public Function Hour() As Integer

  返回小时

• Public Function Minutes() As Integer

  返回分钟

• Public Sub TimeInMinutes(minutes as Integer)

  使用分钟设置时间（例如：1100 分钟等于下午 06:20）

鼠标事件

在 MouseDown 事件中，检查弹出窗口是打开还是关闭，并相应地 Show 或 Hide 它。一个问题是，当点击按钮关闭 ToolStripDropDown 时，它会失去焦点，导致它自动关闭，因此当点击生效时，它会重新打开。为了解决这个问题，请检查指针是否在按钮上，并在 popup_Closing 事件中设置 IsPopupOpen = False。

Private Sub popup_Closing(ByVal sender As Object, _
        ByVal e As ToolStripDropDownClosingEventArgs)
    'Workaround Focus loss
    Try
        If (Not rectDropDownButton.Contains(PointToClient(Control.MousePosition)) _
            Or (e.CloseReason = ToolStripDropDownCloseReason.Keyboard)) Then
            IsPopupOpen = False
        End If

    Catch ex As Exception

    End Try
End Sub

KeyPress 事件

为了快速调整，请按向上或向下箭头键调整分钟，按 Shift-向上或 Shift-向下调整小时。

可空文本框

我希望 gTimePicker 在为空时与 gDataTimePicker 在视觉上匹配，因此我扩展了标准的 TextBox，添加了 null 属性，并重写了 WndProc Sub，在 Text.Length = 0 时绘制 null 属性。

Protected Overrides Sub WndProc(ByRef m As System.Windows.Forms.Message)
    MyBase.WndProc(m)
    Const WM_PAINT As Integer = &HF
    If m.Msg = WM_PAINT Then

        If Me.Text.Length <> 0 Then
            Return
        End If
        Using g As Graphics = Me.CreateGraphics
            g.Clear(Me.BackColor)
            If Not _NullTextInFront Then _
                g.DrawString(_NullText, New Font(Me.Font.Name, Me.Font.Size, _
                FontStyle.Bold), New SolidBrush(_NullTextColor), 0, 0)
            g.FillRectangle(New HatchBrush(_NullHatchStyle, _
                Color.FromArgb(_NullAlpha, _NullColorA), _
                Color.FromArgb(_NullAlpha, _NullColorB)), ClientRectangle)
            If _NullTextInFront Then _
                g.DrawString(_NullText, New Font(Me.Font.Name, Me.Font.Size, _
                FontStyle.Bold), New SolidBrush(_NullTextColor), 0, 0)
        End Using
    End If
End Sub

Private Sub gTextBox_TextChanged(ByVal sender As Object, _
            ByVal e As System.EventArgs) Handles Me.TextChanged
    If Me.Text = "" Or Me.Text.Length = 1 Then Me.Invalidate()
End Sub

设计时附加功能

由于我已有关于 UITypeEditor 的文章，请参阅此处以更详细地了解任何设计时功能：UITypeEditorsDemo[^]。

我为配色方案创建了一个单独的类，以便在编辑器中更容易地对其进行操作。Class TimeColorConverter: Inherits ExpandableObjectConverter 允许直接在属性网格中编辑单个颜色。Class TimeUIEditor : Inherits UITypeEditor 为属性网格中的 Time 属性提供了一个下拉列表。

Class TimeColorsUIEditor : Inherits UITypeEditor 通过按下属性网格中的按钮，打开一个对话框来编辑所有颜色并进行预览。

gDateTimePicker

它看起来像一个 DateTimePicker，因为它 Inherits System.Windows.Forms.DateTimePicker。市面上有很多可空的 DateTimePicker，但我想有些不同（一如既往），所以这是我的版本。一切功能正常，除了您可以将值设置为 Nothing。通常，将 DateTimePicker.Value = Nothing 会导致错误。我一开始通过阴影化 DateTimePicker 控件的 Value 属性，并使用我在其他控件中看到过的 DateTime.MinValue 切换方法，但这导致了很多同步问题，尤其是在我尝试绑定控件时。

是时候重新开始了。DateTimePicker 有三个我需要操作的属性：Value、Format 和 CustomFormat。模拟 Null 的技巧是将 Format 设置为 Custom，并将 CustomFormat = " "，这样无论值是什么，它都会显示一个空格。这在视觉上看起来像一个 NULL，但值并非真正是 NULL，尤其是如果您想绑定它。首先，我隐藏了这些属性

<Browsable(False)> _
<DesignerSerializationVisibility(DesignerSerializationVisibility.Hidden)> _
<EditorBrowsable(EditorBrowsableState.Never)> _
Public Shadows Property Value() As DateTime
    Get
        Return MyBase.Value
    End Get
    Set(ByVal value As DateTime)
        MyBase.Value = value
    End Set
End Property

<Browsable(False)> _
<DesignerSerializationVisibility(DesignerSerializationVisibility.Hidden)> _
<EditorBrowsable(EditorBrowsableState.Never)> _
Public Shadows Property Format() As DateTimePickerFormat
    Get
        Return MyBase.Format
    End Get
    Set(ByVal value As DateTimePickerFormat)
        MyBase.Format = value
    End Set
End Property

<Browsable(False)> _
<DesignerSerializationVisibility(DesignerSerializationVisibility.Hidden)> _
<EditorBrowsable(EditorBrowsableState.Never)> _
Public Shadows Property CustomFormat() As String
    Get
        Return MyBase.CustomFormat
    End Get
    Set(ByVal value As String)
        MyBase.CustomFormat = value
    End Set
End Property

这些属性被 gValue、gFormat 和 gCustomFormat 取代。gValue 的类型定义为 Type Nullable(Of DateTime)，因此 gValue 实际上可以是 Date 或 NULL，无需任何操作。

Private _gValue As Nullable(Of DateTime) = Today
<Editor(GetType(NullableDateTimeTypeEditor), GetType(UITypeEditor))> _
<Bindable(True)> _
<Category("Appearance")> _
Public Property gValue() As Nullable(Of DateTime)
    Get
        Return _gValue
    End Get

    Set(ByVal value As Nullable(Of DateTime))
        CheckFormat(value)
        Dim changed As Boolean = Not _gValue.Equals(value)
        _gValue = value
        If _gValue.HasValue Then
            MyBase.Value = CDate(_gValue)
        End If
        If changed Then RaiseEvent ValueOrNullChanged(Me)
    End Set
End Property

我想要的唯一附加功能是仍然能够在属性网格中拥有日期下拉列表，并且仍然能够将其设置为 NULL。Type Nullable(Of DateTime) 没有自己的编辑器，所以我为它创建了 NullableDateTimeTypeEditor 和 NullableDateTimeDropDown。

修改 null 属性可以更改控件在 Null 状态下的外观。更改 Fill 和/或添加要显示的文本消息。

Protected Overrides Sub WndProc(ByRef m As System.Windows.Forms.Message)
    MyBase.WndProc(m)
    Const WM_ERASEBKGND As Integer = &H14
    If m.Msg = WM_ERASEBKGND Then
        Using g As Graphics = Me.CreateGraphics
            If Not _gValue.HasValue Then
                'Reduce the ClientRectangle so the dropdown button won't get
                'erased when something else covers part of the control
                Dim meRect As Rectangle = New Rectangle(ClientRectangle.X, _
                      ClientRectangle.Y, ClientRectangle.Width - 18,
                      ClientRectangle.Height)

                g.FillRectangle(New SolidBrush(_BackFillColor), meRect)
                If Not _NullTextInFront Then g.DrawString(_NullText, _
                    New Font(Me.Font.Name, Me.Font.Size, FontStyle.Bold), _
                    New SolidBrush(_NullTextColor), 0, 0)
                g.FillRectangle(New HatchBrush(_NullHatchStyle, _
                    Color.FromArgb(_NullAlpha, _NullColorA), _
                    Color.FromArgb(_NullAlpha, _NullColorB)), meRect)
                If _NullTextInFront Then g.DrawString(_NullText, _
                    New Font(Me.Font.Name, Me.Font.Size, FontStyle.Bold), _
                    New SolidBrush(_NullTextColor), 0, 0)
            End If
        End Using
        Return
    End If
End Sub

要清除 gTimePicker 或 gDateTimePicker，请使用 Delete 键，或右键单击控件以显示 ContextMenu。

历史

• 版本 1.0：2009 年 8 月
• 版本 1.1：2009 年 8 月：修复了 24 小时格式问题
• 版本 1.2：2009 年 8 月：添加了 AM PM 按钮
• 版本 1.3：2009 年 8 月：删除了 Time、TimeAMPM 和 HR24 属性并重新开始。它变得太零碎了。
• 版本 1.4：2009 年 9 月
  • 添加了可空功能绑定
  • 添加了可空 DateTimePicker
• 版本 1.5：2010 年 7 月
  • 添加了 Dropdown 和 ContextMenu 打开事件
  • 由于命名冲突，重命名了 gTextBox、gTimeBox
  • 修复了 DateTimePicker 可空功能中的一些错误。
• 版本 1.6：2012 年 2 月
  • 删除了冗余属性代码
  • 右键单击小时设置为 00 分钟
  • 添加了 Null 按钮并修复了可空行为
  • 用直接绘制在 Graphics 表面的数字替换了链接数字
  • 删除了底部中间的分钟框，并增加了直接用鼠标选择分钟的功能
• 版本 1.7：2012 年 2 月
• AM PM 错误修复