VB.NET-Tipp 0142: Textbox für Zeit- und Datumsangaben

von pks

Beschreibung
Hin- und wieder bietet das DateTimePicker-Steuerelement nicht die gewünschten Eigenschaften: beispielsweise wenn ein Datum optional angegeben werden soll. Das in diesem Tipp vorgestellte Steuerelement bietet die Möglichkeit der Eingabe von Daten über Tag, Tag+Monat oder Tag+Monat+Jahr und Uhrzeiten über Stunden, Stunden+Minuten oder Stunden+Minuten+Sekunden bei automatischer Komplettierung mit dem aktuellen Monat und/oder Jahr.
Schwierigkeitsgrad:
Schwierigkeitsgrad 2
Framework-Version(en):
.NET Framework 1.0, .NET Framework 1.1, .NET Framework 2.0, .NET Framework 3.0, .NET Framework 3.5, .NET Framework 4
.NET-Version(en):
Visual Basic 2002, Visual Basic 2003, Visual Basic 2005, Visual Basic 2008, Visual Basic 2010
Download:
Download des Beispielprojektes [13,51 KB]
' Dieser Quellcode stammt von http://www.activevb.de
' und kann frei verwendet werden. Für eventuelle Schäden
' wird nicht gehaftet.

' Um Fehler oder Fragen zu klären, nutzen Sie bitte unser Forum.
' Ansonsten viel Spaß und Erfolg mit diesem Source!

' Projektversion:   Visual Studio 2005
' Option Strict:    An
'
' Referenzen: 
'  - System
'  - System.Data
'  - System.Deployment
'  - System.Drawing
'  - System.Windows.Forms
'  - System.Xml
'
' Imports: 
'  - System
'  - System.Collections
'  - System.Collections.Generic
'  - System.Data
'  - System.Drawing
'  - System.Diagnostics
'  - System.Windows.Forms
'

' ##############################################################################
' ################################# Form1.vb ###################################
' ##############################################################################
Public Class Form1

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

        ' Eigene Fehlerbehandlung möglich für TextBoxDate
        For Each Ctl As Control In Me.Controls
            If TypeOf Ctl Is TextBoxDate Then
                Dim TbD As TextBoxDate = DirectCast(Ctl, TextBoxDate)
                AddHandler TbD.InsertError, AddressOf TextBoxDate_InsertError
                AddHandler TbD.FormatError, AddressOf TextBoxDate_FormatError
            End If
        Next
    End Sub

    Private Sub TextBox1_Enter(ByVal sender As Object, _
        ByVal e As System.EventArgs) Handles TextBox1.Enter

        TextBox1.BackColor = Color.PaleTurquoise
    End Sub

    Private Sub TextBox1_Leave(ByVal sender As Object, _
        ByVal e As System.EventArgs) Handles TextBox1.Leave

        TextBox1.BackColor = SystemColors.Window
    End Sub

    Private Sub TextBoxDate_FormatError(ByVal sender As Object, _
                                        ByVal e As TextBoxDate.ErrorEventArgs)

        ' Eigene Fehlerbehandlung bei Eingabefehlern für Format Datum/Zeit
    End Sub

    Private Sub TextBoxDate_InsertError(ByVal sender As Object, _
                                        ByVal e As TextBoxDate.ErrorEventArgs)

        ' Eigene Fehlerbehandlung bei Einfügefehlern über Clipboard
    End Sub
End Class

' ##############################################################################
' ############################## TextBoxDate.vb ################################
' ##############################################################################
Imports System.ComponentModel
Imports System.Globalization.CultureInfo

Public Enum DateOrTimeFormat
    DateFormat
    TimeFormatShort
    TimeFormatLong
End Enum

''' <summary>
''' Textbox für Datumseingaben
''' </summary>
Public Class TextBoxDate
    Inherits TextBox

    Public Event FormatError As EventHandler(Of ErrorEventArgs)
    Public Event InsertError As EventHandler(Of ErrorEventArgs)

    Public Class ErrorEventArgs
        Inherits System.EventArgs

        Dim m_ErrorMessage As String

        Public Sub New(ByVal mErrorMessage As String)

            m_ErrorMessage = mErrorMessage
        End Sub

        Public ReadOnly Property ErrorMessage() As String
            Get
                Return m_ErrorMessage
            End Get
        End Property
    End Class

    Private m_DateOrTimeFormat As DateOrTimeFormat
    Private m_BackColorFocus As Color = Color.PaleTurquoise
    Private m_BackColor As Color
    Private m_Date As Date
    Private m_LeaveOnEnter As Boolean = True
    Private m_InsertFromClipBoard As Boolean = True
    Private m_FormatErrorShow As Boolean = True
    Private m_FormatErrorShown As Boolean = False
    Private m_FormatErrorMsg As String = "ungültiges Eingabe"
    Private m_InsertErrorMsg As String = "Wert kann nicht eingefügt werden"
    Private m_InsertErrorShow As Boolean = True
    Private m_MouseDownRight As Boolean = False
    Private m_LastText As String
    Private m_Text As String

    <Description("Datum Short, Time Short oder Long gemäss CurrentCulture"), _
        Category("Darstellung")> _
    Public Property DateOrTimeFormat() As DateOrTimeFormat
        Get
            Return m_DateOrTimeFormat
        End Get
        Set(ByVal value As DateOrTimeFormat)
            m_DateOrTimeFormat = value
            If value = TextboxDatum.DateOrTimeFormat.DateFormat Then
                Me.MaxLength = DateFormat.Length
            ElseIf value = TextboxDatum.DateOrTimeFormat.TimeFormatLong Then
                Me.MaxLength = TimeFormatLong.Length
            ElseIf value = TextboxDatum.DateOrTimeFormat.TimeFormatShort Then
                Me.MaxLength = TimeFormatShort.Length
            End If
        End Set
    End Property

    <Description("Regelt, ob über das Clipboard Daten eingefügt " & _
        "werden können"), Category("Verhalten")> _
    Public Property InsertFromClipBoard() As Boolean
        Get
            Return m_InsertFromClipBoard
        End Get
        Set(ByVal value As Boolean)
            m_InsertFromClipBoard = value
        End Set
    End Property

    <Description("Fehlermeldung anzeigen bei " & _
        "Formatfehlern (Tag, Monat, Jahr"), _
        Category("Verhalten")> _
    Public Property FormatErrorShow() As Boolean
        Get
            Return m_FormatErrorShow
        End Get
        Set(ByVal value As Boolean)
            m_FormatErrorShow = value
        End Set
    End Property

    <Description("Fehlermeldung anzeigen bei Insertfehlern " & _
        "(Einfügen über Clipboard)"), _
        Category("Verhalten")> _
    Public Property InsertErrorShow() As Boolean
        Get
            Return m_InsertErrorShow
        End Get
        Set(ByVal value As Boolean)
            m_InsertErrorShow = value
        End Set
    End Property

    <Description("Fehlertext bei einem Formatfehler"), _
        Category("Verhalten")> _
    Public Property FormatErrorMsg() As String
        Get
            Return m_FormatErrorMsg
        End Get
        Set(ByVal value As String)
            m_FormatErrorMsg = value
        End Set
    End Property

    <Description("Fehlertext bei Einfügen von Werten über Clipboard"), _
        Category("Verhalten")> _
    Public Property InsertErrorMsg() As String
        Get
            Return m_InsertErrorMsg
        End Get
        Set(ByVal value As String)
            m_InsertErrorMsg = value
        End Set
    End Property

    <Description("Separator für Trennung Tag, Monat, Jahr gemäss " & _
        "CurrentCulture"), Category("Darstellung")> _
    Public ReadOnly Property DateSeparator() As Char
        Get
            Return Convert.ToChar(CurrentCulture.DateTimeFormat.DateSeparator)
        End Get
    End Property

    <Description("Separator für Trennung Stunden, Minuten, Sekunden gemäss " & _
        "CurrentCulture"), Category("Darstellung")> _
    Public ReadOnly Property TimeSeparator() As Char
        Get
            Return Convert.ToChar(CurrentCulture.DateTimeFormat.TimeSeparator)
        End Get
    End Property

    <Description("Formatierung Date laut CurrentCulture"), _
        Category("Darstellung")> _
    Public ReadOnly Property DateFormat() As String
        Get
            Return CurrentCulture.DateTimeFormat.ShortDatePattern
        End Get
    End Property

    <Description("Formatierung Time laut CurrentCulture"), _
        Category("Darstellung")> _
    Public ReadOnly Property TimeFormatLong() As String
        Get
            Return CurrentCulture.DateTimeFormat.LongTimePattern
        End Get
    End Property

    <Description("Formatierung Time laut CurrentCulture"), _
        Category("Darstellung")> _
    Public ReadOnly Property TimeFormatShort() As String
        Get
            Return CurrentCulture.DateTimeFormat.ShortTimePattern
        End Get
    End Property

    <Description("Backcolor bei Focuserhalt"), _
        Category("Darstellung")> _
    Public Property BackColorFocus() As Color
        Get
            Return m_BackColorFocus
        End Get
        Set(ByVal value As Color)
            m_BackColorFocus = value
        End Set
    End Property

    Public Sub New()
        DateOrTimeFormat = TextboxDatum.DateOrTimeFormat.DateFormat
    End Sub

    <Description("Bei Enter zum nächsten Control wechseln"), _
        Category("Verhalten")> _
    Public Property LeaveOnEnter() As Boolean
        Get
            Return m_LeaveOnEnter
        End Get
        Set(ByVal value As Boolean)
            m_LeaveOnEnter = value
        End Set
    End Property

    Protected Overrides Sub OnEnter(ByVal e As System.EventArgs)

        m_BackColor = Me.BackColor
        Me.BackColor = BackColorFocus

        If Not m_FormatErrorShown Then
            m_Text = Me.Text
        End If
        Me.SelectionStart = 0
        Me.SelectionLength = Me.Text.Length

        MyBase.OnEnter(e)
    End Sub

    Protected Overrides Sub OnLeave(ByVal e As System.EventArgs)

        m_FormatErrorShown = False
        Me.BackColor = m_BackColor
        MyBase.OnLeave(e)
    End Sub

    Protected Overrides Sub OnMouseDown( _
        ByVal e As System.Windows.Forms.MouseEventArgs)

        ' Check für Einfügen über Clipboard vorbereiten
        m_MouseDownRight = (e.Button = Windows.Forms.MouseButtons.Right)
        m_LastText = Me.Text
        MyBase.OnMouseDown(e)
    End Sub

    Protected Overrides Sub OnMouseUp( _
        ByVal mevent As System.Windows.Forms.MouseEventArgs)

        m_MouseDownRight = False
        MyBase.OnMouseUp(mevent)
    End Sub

    Protected Overrides Sub OnTextChanged(ByVal e As System.EventArgs)

        If m_MouseDownRight Then
            ' Einfügen über Clipboard erfolgt
            m_MouseDownRight = False
            If Not CanInsert(Me.Text) Or (Not InsertFromClipBoard) Then
                Me.Text = m_LastText
                Me.Refresh()
                Dim ErrMsg As String = "Werte können nicht eingefügt werden"
                Dim Titel As String = "einfügen über Clipboard"
                If InsertErrorShow Then
                    MessageBox.Show(ErrMsg, Titel, MessageBoxButtons.OK, _
                                    MessageBoxIcon.Error)
                Else
                    RaiseEvent InsertError(Me, New ErrorEventArgs(ErrMsg))
                End If
                Exit Sub
            End If
        End If

        MyBase.OnTextChanged(e)
    End Sub

    Protected Overrides Sub OnKeyDown( _
        ByVal e As System.Windows.Forms.KeyEventArgs)

        ' Einfügen über Clipboard abhandeln
        If e.Shift AndAlso (e.KeyCode = Keys.Insert) Then
            ' Erlaubt ?
            If Not InsertFromClipBoard Then
                e.Handled = True
                Exit Sub
            Else
                Dim s As String = Me.Text.Insert(Me.SelectionStart, _
                                                 Clipboard.GetText)
                If Me.SelectionLength = Me.Text.Length Then
                    s = Clipboard.GetText
                End If
                ' Einfügen möglich ?
                If Not CanInsert(s) Then
                    Dim ErrMsg As String = "Werte können nicht eingefügt werden"
                    Dim Titel As String = "einfügen über Clipboard"
                    e.Handled = True
                    If InsertErrorShow Then
                        MessageBox.Show(ErrMsg, Titel, MessageBoxButtons.OK, _
                                        MessageBoxIcon.Error)
                    Else
                        RaiseEvent InsertError(Me, New ErrorEventArgs(ErrMsg))
                    End If
                    Exit Sub
                End If
            End If
        End If
        MyBase.OnKeyDown(e)
    End Sub

    Protected Overrides Sub OnKeyPress( _
        ByVal e As System.Windows.Forms.KeyPressEventArgs)

        ' Zulassig Kopieren Strg+C,Insert über Strg+V
        Dim i As Integer = Convert.ToInt32(e.KeyChar)
        If i = 3 Then
            Exit Sub
        ElseIf i = 22 Then
            If Not InsertFromClipBoard Then
                e.Handled = True
                Exit Sub
            Else
                Dim s As String = Me.Text.Insert(Me.SelectionStart, _
                                                 Clipboard.GetText)
                If Me.SelectionLength = Me.Text.Length Then
                    s = Clipboard.GetText
                End If
                'Einfügen möglich ?
                If Not CanInsert(s) Then
                    e.Handled = True
                    Dim ErrMsg As String = "Werte können nicht eingefügt werden"
                    Dim Titel As String = "einfügen über Clipboard"
                    e.Handled = True
                    If InsertErrorShow Then
                        MessageBox.Show(ErrMsg, Titel, MessageBoxButtons.OK, _
                                        MessageBoxIcon.Error)
                    Else
                        RaiseEvent InsertError(Me, New ErrorEventArgs(ErrMsg))
                    End If
                End If
            End If
            Exit Sub
        End If


        Select Case e.KeyChar
            Case "0"c To "9"c
            Case ","c, "."c, "/"c, ":"c
                If DateOrTimeFormat = _
                    TextboxDatum.DateOrTimeFormat.DateFormat Then

                    e.KeyChar = DateSeparator
                Else
                    e.KeyChar = TimeSeparator
                End If

            Case Convert.ToChar(8)

            Case Convert.ToChar(13)
                e.Handled = True
                If LeaveOnEnter Then
                    SendKeys.Send("{Tab}")
                End If

            Case Convert.ToChar(27)
                e.Handled = True
                Me.Text = m_Text
                Me.SelectionStart = 0
                Me.SelectionLength = Me.Text.Length
            Case Else
                e.Handled = True
        End Select
        MyBase.OnKeyPress(e)
    End Sub

    Protected Overrides Sub OnValidating( _
        ByVal e As System.ComponentModel.CancelEventArgs)

        MyBase.OnValidating(e)

        m_FormatErrorShown = False
        If DateOrTimeFormat = TextboxDatum.DateOrTimeFormat.DateFormat Then
            If Not IsDateOk() Then
                e.Cancel = True
                Dim Titel As String = "Formatfehler Datum"
                m_FormatErrorShown = True
                If FormatErrorShow Then
                    MessageBox.Show(FormatErrorMsg, Titel, _
                                    MessageBoxButtons.OK, MessageBoxIcon.Error)
                Else
                    RaiseEvent FormatError(Me, _
                                           New ErrorEventArgs(FormatErrorMsg))
                End If
                Exit Sub
            End If
        Else
            If Not IsTimeOk() Then
                e.Cancel = True
                Dim Titel As String = "Formatfehler Uhrzeit"
                m_FormatErrorShown = True
                If FormatErrorShow Then
                    MessageBox.Show(FormatErrorMsg, Titel, _
                                    MessageBoxButtons.OK, MessageBoxIcon.Error)
                Else
                    RaiseEvent FormatError(Me, _
                                           New ErrorEventArgs(FormatErrorMsg))
                End If
                Exit Sub
            End If

        End If
    End Sub

    Protected Overrides Sub OnValidated(ByVal e As System.EventArgs)

        ' Zum Schluss formatieren
        If Not String.IsNullOrEmpty(Me.Text) Then
            If DateOrTimeFormat = TextboxDatum.DateOrTimeFormat.DateFormat Then
                Me.Text = m_Date.ToString(DateFormat)
            ElseIf DateOrTimeFormat = _
                TextboxDatum.DateOrTimeFormat.TimeFormatLong Then

                Me.Text = m_Date.ToString(TimeFormatLong)
            ElseIf DateOrTimeFormat = _
                TextboxDatum.DateOrTimeFormat.TimeFormatShort Then

                Me.Text = m_Date.ToString(TimeFormatShort)
            End If
        End If

        MyBase.OnValidated(e)
    End Sub

    ''' <summary>
    ''' Prüft, ob ein Datum gültig ist
    ''' </summary>
    Private Function IsDateOk() As Boolean

        If String.IsNullOrEmpty(Me.Text) Then
            Return True
        End If

        Dim s() As String = Me.Text.Split(DateSeparator)
        If s.GetUpperBound(0) > 2 Then
            Return False
        End If

        ReDim Preserve s(2)
        If String.IsNullOrEmpty(s(2)) Then
            s(2) = Date.Today.Year.ToString
        End If

        If DateFormat.ToLower.StartsWith("d") Then
            If String.IsNullOrEmpty(s(1)) Then
                s(1) = Date.Today.Month.ToString
            End If

            If (Integer.Parse(s(0)) = 0) Or (Integer.Parse(s(0)) > 31) Then
                Return False
            End If

            If (Integer.Parse(s(1)) = 0) Or (Integer.Parse(s(1)) > 12) Then
                Return False
            End If

        Else
            If String.IsNullOrEmpty(s(1)) Then
                s(1) = Date.Today.Day.ToString
            End If

            If (Integer.Parse(s(1)) = 0) Or (Integer.Parse(s(1)) > 31) Then
                Return False
            End If

            If (Integer.Parse(s(0)) = 0) Or (Integer.Parse(s(0)) > 12) Then
                Return False
            End If
        End If

        If Integer.Parse(s(2)) > 9999 Then
            Return False
        ElseIf Integer.Parse(s(2)) < 100 Then
            Dim i As Integer = Convert.ToInt32(s(2))
            If i >= 80 Then
                i += 1900
            Else
                i += 2000
            End If
            s(2) = i.ToString
        End If

        Dim sd As String = String.Join(DateSeparator, s)
        If Date.TryParse(sd, m_Date) Then
            Return True
        End If
        Return False
    End Function

    ''' <summary>
    ''' Prüft, ob eine Uhrzeit gültig ist
    ''' </summary>
    Private Function IsTimeOk() As Boolean

        If String.IsNullOrEmpty(Me.Text) Then
            Return True
        End If

        Dim s() As String = Me.Text.Split(TimeSeparator)
        If s.GetUpperBound(0) > 2 Then
            Return False
        End If

        ReDim Preserve s(2)
        If String.IsNullOrEmpty(s(1)) Then
            s(1) = "00"
        End If

        If String.IsNullOrEmpty(s(2)) Then
            s(2) = "00"
        End If

        If Integer.Parse(s(0)) > 23 Then
            Return False
        ElseIf Integer.Parse(s(1)) > 59 Then
            Return False
        ElseIf Integer.Parse(s(2)) > 59 Then
            Return False
        End If

        Dim sd As String = String.Join(TimeSeparator, s)
        If Date.TryParse(sd, m_Date) Then
            Return True
        End If
        Return False
    End Function

    ''' <summary>
    ''' Prüft, ob ein Wert eingegeben werden kann
    ''' </summary>
    Private Function CanInsert(ByVal s As String) As Boolean

        Dim d As Date = Nothing
        Dim Result As Boolean = Date.TryParse(s, d)
        If Not Result Then
            Return Result
        End If

        If DateOrTimeFormat = TextboxDatum.DateOrTimeFormat.DateFormat Then
            If s.IndexOf(TimeSeparator) >= 0 Then
                Return False
            End If
        Else
            If s.IndexOf(DateSeparator) >= 0 Then
                Return False
            End If
        End If
        Return True
    End Function
End Class
Ihre Meinung

Falls Sie Fragen zu diesem Artikel haben oder Ihre Erfahrung mit anderen Nutzern austauschen möchten, dann teilen Sie uns diese bitte in einem der unten vorhandenen Themen oder über einen neuen Beitrag mit. Hierzu können sie einfach einen Beitrag in einem zum Thema passenden Forum anlegen, welcher automatisch mit dieser Seite verknüpft wird.