Feedback

VB - Nullable DateTextbox

Veröffentlicht von am 08.04.2009
(1 Bewertungen)
Da ich in meinen Projekten recht intensiv Datumseingaben
verwende,wäre eigentlich ein ''Datetimepicker'' das Control der Wahl.
Irgendwann war ich es satt, mich mit den Beschränkungen eines selbsgebauten ''Nullable DateTimepickers'' unter Vista herumzuschlagen (u.a. keine stabile Lösung für ''Backcolor''. Und da die händische Eingabe eines Datums allemal schneller geht, als die Auswahl über das DTP-control, ist dies Klasse entstanden,
die genau meine Vorstellungen entspricht.
GFU-Schulungen  [Anzeige]

ASP.NET 2.0 und 3.5

Dieser Kurs vermittelt Ihnen alle Erweiterungen von Microsoft ASP.NET 2.0. Zu diesen zählen u. a. Data Bindung, Master Pages, und Security.

VB.NET 2017/2015/2013 Komplett

Ziel des Seminars ist der flexible Umgang mit VB.NET, wie z.B. die damit verbundene eigenständige Entwicklung von Programmen oder das Verwenden von Datenbanken.

Imports System.Windows.Forms
Imports System.ComponentModel
Imports System.Drawing

'''''' <summary>
'''''' Ein Control zur geprüften Eingabe eines Datums in eine Textbox im Format dd.MM.yyyy
'''''' </summary>
'''''' <remarks>
'''''' </remarks>
<ToolboxBitmap(GetType(TextBox))> _
Public Class DateTextbox
    Inherits TextBox

#Region "   Private variables "

    Private m_NullText As String
    Private m_Readonly As Boolean
    Private m_IsNull As Boolean
    Private WithEvents m_MenuItem As MenuItem

    Private m_EP As ErrorProvider
    Private m_ErrorText As String

#End Region

#Region "   Constructor "

    Public Sub New()

        MyBase.new()

        m_EP = New ErrorProvider
        m_EP.SetIconAlignment(Me, ErrorIconAlignment.MiddleRight)
        m_EP.SetError(Me, "")
        m_ErrorText = "Das eingegebene Datum ist ungültig !!!"
        Me.MaxLength = 10
        m_NullText = "<Kein Datum>"
        m_Readonly = False
        Me.IsNull = True
        Me.ContextMenu = New ContextMenu
        Me.m_MenuItem = New MenuItem
        m_MenuItem.Text = "&Kopieren"
        m_MenuItem.Shortcut = Shortcut.CtrlC
        m_MenuItem.ShowShortcut = True
        AddHandler m_MenuItem.Click, AddressOf OnClickCopy
        Me.ContextMenu.MenuItems.Add(0, m_MenuItem)

    End Sub

#End Region

#Region "   Events and event handling "

    <Category("DateTextbox")> _
    <Description("Wird bei jeder Änderung des Textboxinhaltes ausgelöst.")> _
    Public Event ValueChanged(ByVal sender As Object, ByVal e As DateTextboxEventArgs)

    Private Sub OnClickCopy()
        Clipboard.Clear()
        Clipboard.SetText(Me.Text)
    End Sub

    Protected Overrides Sub OnKeyPress(ByVal e As KeyPressEventArgs)

        MyBase.OnKeyPress(e)

        Select Case True

            Case e.KeyChar = Chr(3)
                e.Handled = False

            Case Me.Readonly
                e.Handled = True

            Case (e.KeyChar >= "0" AndAlso e.KeyChar <= "9") Or e.KeyChar = "." Or e.KeyChar = vbBack    '' Zahlen, Backspace und Komma zulassen
                If m_IsNull Then
                    Me.SelectAll()
                End If
                m_IsNull = False
                e.Handled = False

            Case e.KeyChar = vbCr
                ValidateTextboxEntry()
                Me.SelectAll()
                e.Handled = True

            Case Else
                e.Handled = True

        End Select

    End Sub

    Protected Overrides Sub OnKeyDown(ByVal e As System.Windows.Forms.KeyEventArgs)
        MyBase.OnKeyDown(e)
        Select Case True
            Case e.Control AndAlso e.KeyCode = Keys.C
                e.Handled = False
            Case Me.[Readonly]
                e.Handled = True
            Case e.KeyCode = Keys.Delete
                Me.IsNull = True
                e.Handled = True
        End Select

    End Sub

    Protected Overrides Sub OnValidating(ByVal e As System.ComponentModel.CancelEventArgs)
        MyBase.OnValidating(e)
        e.Cancel = Not Me.ValidateTextboxEntry
    End Sub

    Protected Overrides Sub OnGotFocus(ByVal e As System.EventArgs)
        MyBase.OnGotFocus(e)
        Me.SelectAll()
    End Sub

    Protected Overrides Sub OnTextChanged(ByVal e As System.EventArgs)
        MyBase.OnTextChanged(e)
        RaiseEvent ValueChanged(Me, New DateTextboxEventArgs(IsDate(Me.Text), Me.Value))
    End Sub

#End Region

#Region "   Public properties "

    <Category("DateTextbox")> _
    <Description("Datumswert der Eingabe im Format dd.MM.yyyy. Bei ungültigem Datum oder gelöschtem Datum wird SBNULL.VALUE zurückgegen.")> _
    Public Property DBValue() As Object
        Get
            If Me.Value = Nothing Then
                Return DBNull.Value
            Else
                Return Me.Value
            End If
        End Get
        Set(ByVal value As Object)
            If value Is DBNull.Value Then
                Me.Value = Nothing
            Else
                Me.Value = value
            End If
        End Set
    End Property

    <Category("DateTextbox")> _
    <Description("Datumswert der Eingabe im Format dd.MM.yyyy. Bei ungültigem Datum oder gelöschtem datum wird NOTHING zurückgegen.")> _
    Public Property Value() As Date
        Get
            Select Case True
                Case Me.IsNull
                    Return Nothing
                Case Not IsDate(Me.Text)
                    Return Nothing
                Case Else
                    Return DateValue(Me.Text).Date
            End Select
        End Get
        Set(ByVal value As Date)
            If value = Nothing Then
                Me.IsNull = True
            Else
                Me.IsNull = False
                Me.Text = value.ToString("d")
            End If
        End Set
    End Property

    <Category("DateTextbox")> _
    <Description("Gibt an, ob Eingaben erlaubt sind, oder verworfen werden. <Strg><C> (Clipborad-Copy) ist davon ausgenommen und steht immer zur Verfügung.")> _
    Public Overloads Property [Readonly]() As Boolean
        Get
            Return m_Readonly
        End Get
        Set(ByVal value As Boolean)
            m_Readonly = value
        End Set
    End Property

    <Category("DateTextbox")> _
    <Description("Der Text, der bei Value=Nothing oder Value=DBnull.value anezeigt wird.")> _
    Public Property NullText() As String
        Get
            Return m_NullText
        End Get
        Set(ByVal value As String)
            m_NullText = value
        End Set
    End Property

    <Category("DateTextbox")> _
    <Description("Der Text, der bei ungültigem Datum zur Zeit der Validierung im Errorprovider angezeigt wird.")> _
    Public Property ErrorText() As String
        Get
            Return m_ErrorText
        End Get
        Set(ByVal value As String)
            m_ErrorText = value
        End Set
    End Property

#End Region

#Region "   Private methods & properties "

    Private Function ValidateTextboxEntry() As Boolean

        m_EP.SetError(Me, "")

        Select Case True

            Case Me.IsNull
                Return True

            Case Not IsDate(Me.Text)
                m_EP.SetError(Me, m_ErrorText)

            Case Else
                Me.Text = DateValue(Me.Text)
                Return True

        End Select

    End Function

    Private Property IsNull() As Boolean
        Get
            Return m_IsNull
        End Get
        Set(ByVal value As Boolean)
            m_IsNull = value
            If m_IsNull Then
                Me.Text = NullText
                Me.SelectionStart = 0
                Me.SelectAll()
            End If
        End Set
    End Property

#End Region

#Region "   Class specific eventargs "

    Public Class DateTextboxEventArgs

        Private m_IsValid As Boolean
        Private m_Value As Date

        Public Sub New(ByVal f_IsValid As Boolean, ByVal f_Value As Date)
            m_IsValid = f_IsValid
            m_Value = f_Value
        End Sub

        Public ReadOnly Property IsValid() As Boolean
            Get
                Return m_IsValid
            End Get
        End Property

        Public ReadOnly Property Value() As Date
            Get
                Return m_Value
            End Get
        End Property

    End Class

#End Region

End Class

Kommentare zum Snippet

 

Logge dich ein, um hier zu kommentieren!