VB.NET-Tipp 0141: Textbox für numerische Eingaben

von pks

Beschreibung
Dieser Tipp präsentiert eine TextBox für numerische Eingaben. Diese erlaubt es das Format der eingebbaren Zahl (Anzahl der Stellen vor und nach dem Komma) festzulegen und bietet eine Vielzahl an Darstellungmöglichkeiten (unterschiedliche Hintergrundfarbe bei Fokus, unterschiedliche Textfarben für positive und negative Zahlen)
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 [14,33 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 TboxEnter(ByVal sender As Object, ByVal e As System.EventArgs)

        DirectCast(sender, TextBox).BackColor = Color.PaleTurquoise
    End Sub

    Private Sub TboxNInsertError(ByVal sender As Object, _
                                 ByVal e As TextboxNum.EventArgs)

        'Eingabefehler behandeln
    End Sub

    Private Sub TboxKeyPress(ByVal sender As Object, _
                             ByVal e As System.Windows.Forms.KeyPressEventArgs)

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

    Private Sub TboxLeave(ByVal sender As Object, ByVal e As System.EventArgs)

        DirectCast(sender, TextBox).BackColor = SystemColors.Window
    End Sub


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

        TextBoxHandlesAdd(Me)
    End Sub

    Private Sub TextBoxHandlesAdd(ByVal Container As Control, _
            Optional ByVal SubContainerAlso As Boolean = True)

        For Each Ctl As Control In Container.Controls
            If TypeOf Ctl Is TextBox Then
                AddHandler Ctl.Enter, AddressOf TboxEnter
                AddHandler Ctl.KeyPress, AddressOf TboxKeyPress
                AddHandler Ctl.Leave, AddressOf TboxLeave

            ElseIf TypeOf Ctl Is TextboxNum Then
                Dim Tbox As TextboxNum = DirectCast(Ctl, TextboxNum)
                AddHandler Tbox.InsertError, AddressOf TboxNInsertError

            ElseIf (Ctl.Controls.Count > 0) AndAlso SubContainerAlso Then
                TextBoxHandlesAdd(Ctl, SubContainerAlso)
            End If
        Next
    End Sub


    Private Sub TextboxNum1_TextChanged(ByVal sender As System.Object, _
        ByVal e As System.EventArgs) Handles TextboxNum1.TextChanged

    End Sub
End Class

' ##############################################################################
' ############################### TextboxNum.vb ################################
' ##############################################################################
Imports System.ComponentModel

Public Class TextboxNum
    Inherits TextBox

    Private m_DecSeparator As Char = Convert.ToChar( _
       System.Globalization.CultureInfo.CurrentCulture.NumberFormat.CurrencyDecimalSeparator)
    Private m_GroupSeparator As Char = Convert.ToChar( _
        System.Globalization.CultureInfo.CurrentCulture.NumberFormat.CurrencyGroupSeparator)
    Private m_DigitsTotal As Integer = 9
    Private m_DigitsAfterPoint As Integer = 0
    Private m_DigitsBeforePoint As Integer = 9
    Private m_MinusAllowed As Boolean = False
    Private m_ShowNullOnEmpty As Boolean = False
    Private m_TextAlignFocus As Windows.Forms.HorizontalAlignment _
        = HorizontalAlignment.Left
    Private m_TextAlignNotFocus As Windows.Forms.HorizontalAlignment _
        = HorizontalAlignment.Right
    Private m_BackColorFocus As Color = Color.PaleTurquoise
    Private m_BackColorNotFocus As Color
    Private m_ForeColorMinus As Color
    Private m_ForeColorPlus As Color
    Private m_InsertFromClipBoard As Boolean = True
    Private m_FormatErrorShow As Boolean = False
    Private m_InsertErrorShow As Boolean = True
    Private m_Leaving As Boolean = False
    Private m_LeaveOnEnter As Boolean = True
    Private m_MouseDownRight As Boolean = False
    Private m_LastText As String
    Private m_FormatNumeric As String = "########0"

#Region " Events "
    Public Event FormatError As EventHandler(Of EventArgs)
    Public Event InsertError As EventHandler(Of EventArgs)

    Public Class EventArgs
        Inherits System.EventArgs

        Private m_ErrorMessage As String

        Public Sub New(ByVal mErrorMessage As String)

            m_ErrorMessage = mErrorMessage
        End Sub

        ''' <summary>
        ''' liefert eine Fehlermeldung
        ''' </summary>
        Public ReadOnly Property ErrorMessage() As String
            Get
                Return m_ErrorMessage
            End Get
        End Property
    End Class

#End Region

    Public Sub New()

        Me.TextAlignNotFocus = HorizontalAlignment.Right
        Me.TextAlign = HorizontalAlignment.Right
        m_ForeColorPlus = Me.ForeColor
        m_ForeColorMinus = Color.Red
    End Sub

    <Description("Regelt ob über Enter auf das nächste Steuerelementfeld " & _
        "gewechselt wird"), 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

    <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 (Anzahl Vor- " & _
        "oder Nachkommastellen, Minus"), 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("Dezimalzeichen wie Komma (,)"), Category("Darstellung")> _
    Public Property DecSeparator() As Char
        Get
            Return m_DecSeparator
        End Get
        Set(ByVal value As Char)
            m_DecSeparator = value
        End Set
    End Property

    <Description("Tausendertrennzeichen wie Punkt (.)"), _
        Category("Darstellung")> _
    Public Property Groupseparator() As Char
        Get
            Return m_GroupSeparator
        End Get
        Set(ByVal value As Char)
            m_GroupSeparator = value
        End Set
    End Property

    <Description("Gültige Formatierung wie (-#,###,##0.00), legt auch die " & _
        "Maximaleingabe fest ausser Minus "), Category("Darstellung")> _
    Public Property FormatNumeric() As String
        Get
            Return m_FormatNumeric
        End Get
        Set(ByVal value As String)
            If String.IsNullOrEmpty(value) Then
                MessageBox.Show("ungültiges Format")
            Else
                m_FormatNumeric = value
                m_MinusAllowed = False
                If value.IndexOf("-") >= 0 Then
                    m_MinusAllowed = True
                End If
                Dim s() As String = value.Replace(",", "").Split("."c)
                If s.GetUpperBound(0) = 1 Then
                    m_DigitsAfterPoint = s(1).Length
                Else
                    m_DigitsAfterPoint = 0
                End If
                m_DigitsBeforePoint = s(0).Replace("-", "").Length
                m_DigitsTotal = m_DigitsBeforePoint
                If m_DigitsAfterPoint > 0 Then
                    m_DigitsTotal += m_DigitsAfterPoint + 1
                End If
            End If
        End Set
    End Property

    <Description("Forecolor bei Positivwerten"), _
        Category("Darstellung")> _
    Public Property ForeColorPlus() As System.Drawing.Color
        Get
            Return m_ForeColorPlus
        End Get
        Set(ByVal value As System.Drawing.Color)
            m_ForeColorPlus = value
        End Set
    End Property

    <Description("Forecolor bei Minuswerten"), _
        Category("Darstellung")> _
    Public Property ForeColorMinus() As Color
        Get
            Return m_ForeColorMinus
        End Get
        Set(ByVal value As Color)
            m_ForeColorMinus = value
        End Set
    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

    <Description("Backcolor ohne Focus"), _
        Category("Darstellung")> _
    Public Property BackColorNotFocus() As Color
        Get
            Return m_BackColorNotFocus
        End Get
        Set(ByVal value As Color)
            m_BackColorNotFocus = value
        End Set
    End Property

    <Description("bei Leereingabe gemäss Formatierung Nullen anzeigen"), _
        Category("Darstellung")> _
    Public Property ShowNullOnEmpty() As Boolean
        Get
            Return m_ShowNullOnEmpty
        End Get
        Set(ByVal value As Boolean)
            m_ShowNullOnEmpty = value
        End Set
    End Property

    <Description("Minuseingabe erlaubt, wird gesteuert durch ein " & _
        "führendes Minuszeichen (-) in FormatNumeric"), Category("Verhalten")> _
    Public ReadOnly Property MinusAllowed() As Boolean
        Get
            Return m_MinusAllowed
        End Get
    End Property

    <Description("Ausrichtung bei Focuserhalt"), _
        Category("Darstellung")> _
    Public Property TextAlignFocus() As Windows.Forms.HorizontalAlignment
        Get
            Return m_TextAlignFocus
        End Get
        Set(ByVal value As Windows.Forms.HorizontalAlignment)
            m_TextAlignFocus = value
        End Set
    End Property

    <Description("Ausrichtung ohne Focus"), _
        Category("Darstellung")> _
    Public Property TextAlignNotFocus() As Windows.Forms.HorizontalAlignment
        Get
            Return m_TextAlignNotFocus
        End Get
        Set(ByVal value As Windows.Forms.HorizontalAlignment)
            m_TextAlignNotFocus = value
        End Set
    End Property

    <Description("Gesamtkapazität = Vorkomma+Komma+Nachkomma (ohne Minus)"), _
        Category("Verhalten")> _
    Public ReadOnly Property DigitsTotal() As Integer
        Get
            Return m_DigitsTotal
        End Get
    End Property

    Protected Overrides Sub OnEnter(ByVal e As System.EventArgs)
        ' Einrichten Align und Farben
        Me.TextAlign = TextAlignFocus
        Me.BackColor = BackColorFocus
        MyBase.OnEnter(e)
    End Sub

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

        ' Einfügen über Clipboard abhandeln
        If e.Shift And (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)
                ' 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 EventArgs(ErrMsg))
                    End If
                    Exit Sub
                End If
            End If
        End If
        MyBase.OnKeyDown(e)
    End Sub

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

        ' Beim Verlassen formatieren 
        If Not String.IsNullOrEmpty(Me.Text) Then
            Dim s As String = Me.Text.Replace(Groupseparator.ToString, "")
            Dim c As Decimal = Decimal.Parse(s)
            Me.Text = c.ToString(FormatNumeric.Replace("-", ""))
        Else
            If ShowNullOnEmpty Then
                Dim d As Double = 0
                Me.Text = d.ToString(m_FormatNumeric)
            End If
        End If
        Me.BackColor = BackColorNotFocus

        MyBase.OnValidated(e)
    End Sub

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

        Dim Frm As Form = DirectCast(Me.Parent, Form)
        Dim Ctl As Control = Frm.ActiveControl
        Me.TextAlign = TextAlignNotFocus
        Ctl.Focus()

        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 EventArgs(ErrMsg))
                End If
                Exit Sub
            End If
        End If

        'Farbe für Plus/Minus regulieren
        If Not String.IsNullOrEmpty(Me.Text) Then
            If Me.Text.IndexOf("-") >= 0 Then
                Me.ForeColor = m_ForeColorMinus
            Else
                Me.ForeColor = m_ForeColorPlus
            End If
        End If
        MyBase.OnTextChanged(e)
    End Sub

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

        MyBase.OnEnter(e)

        Dim ErrMsg As String = Nothing
        Dim Titel As String = "Eingabe numerisch"

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


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

            Case Groupseparator
                If FormatNumeric.IndexOf(Groupseparator) < 0 Then
                    e.Handled = True
                Else
                    If Me.SelectionLength = Me.Text.Length Then
                        Me.Text = ""
                    End If
                End If

            Case "0"c To "9"c
                If Me.SelectionLength = Me.Text.Length Then
                    Me.Text = ""
                End If
                If Not String.IsNullOrEmpty(Me.Text) Then
                    Dim s() As String = Me.Text.Replace( _
                        Groupseparator.ToString, "").Split(DecSeparator)
                    s(0) = s(0).Replace("-", "")
                    If s.GetUpperBound(0) = 1 Then
                        If Me.SelectionStart <= _
                            Me.Text.IndexOf(DecSeparator) Then

                            If s(0).Length = m_DigitsBeforePoint Then
                                ErrMsg = "maximal " & _
                                    m_DigitsBeforePoint.ToString & _
                                    " (Vorkomma)Stellen"
                                e.Handled = True
                                If FormatErrorShow Then
                                    MessageBox.Show(ErrMsg, Titel, _
                                                    MessageBoxButtons.OK, _
                                                    MessageBoxIcon.Error)
                                Else
                                    RaiseEvent FormatError(Me, _
                                        New EventArgs(ErrMsg))
                                End If
                            End If
                        Else
                            If s(1).Length = m_DigitsAfterPoint Then
                                ErrMsg = "maximal " & _
                                    m_DigitsAfterPoint.ToString & _
                                    " Nachkommastellen"
                                e.Handled = True
                                If FormatErrorShow Then
                                    MessageBox.Show(ErrMsg, Titel, _
                                                    MessageBoxButtons.OK, _
                                                    MessageBoxIcon.Error)
                                Else
                                    RaiseEvent FormatError(Me, _
                                        New EventArgs(ErrMsg))
                                End If
                            End If
                        End If
                    Else
                        If s(0).Length = m_DigitsBeforePoint Then
                            ErrMsg = "maximal " & _
                                m_DigitsBeforePoint.ToString & _
                                " (Vorkomma)Stellen"
                            e.Handled = True
                            If FormatErrorShow Then
                                MessageBox.Show(ErrMsg, Titel, _
                                                MessageBoxButtons.OK, _
                                                MessageBoxIcon.Error)
                            Else
                                RaiseEvent FormatError(Me, _
                                                       New EventArgs(ErrMsg))
                            End If
                        End If
                    End If
                End If
            Case "-"c
                If Not MinusAllowed Then
                    ErrMsg = "keine Minuswerte erlaubt"
                    e.Handled = True
                    If FormatErrorShow Then
                        MessageBox.Show(ErrMsg, Titel, _
                                        MessageBoxButtons.OK, _
                                        MessageBoxIcon.Error)
                    Else
                        RaiseEvent FormatError(Me, New EventArgs(ErrMsg))
                    End If
                ElseIf Me.SelectionLength = Me.Text.Length Then
                    Me.Text = ""
                Else
                    If (Me.Text.IndexOf("-"c) >= 0) Or _
                        (Me.SelectionStart > 0) Then

                        ErrMsg = "Minuszeichen immer an 1. Stelle"
                        e.Handled = True
                        If FormatErrorShow Then
                            MessageBox.Show(ErrMsg, Titel, _
                                            MessageBoxButtons.OK, _
                                            MessageBoxIcon.Error)
                        Else
                            RaiseEvent FormatError(Me, New EventArgs(ErrMsg))
                        End If
                    End If
                End If

            Case Convert.ToChar(8)

            Case DecSeparator
                If m_DigitsAfterPoint = 0 Then
                    ErrMsg = "keine Nachkommastellen erlaubt"
                    e.Handled = True
                    If FormatErrorShow Then
                        MessageBox.Show(ErrMsg, Titel, _
                                        MessageBoxButtons.OK, _
                                        MessageBoxIcon.Error)
                    Else
                        RaiseEvent FormatError(Me, New EventArgs(ErrMsg))
                    End If
                ElseIf Me.SelectionLength = Me.Text.Length Then
                    Me.Text = ""
                Else

                    If Me.Text.IndexOf(DecSeparator) >= 0 Then
                        e.Handled = True
                    End If
                End If

            Case Else
                e.Handled = True
        End Select
    End Sub

    ''' <summary>
    ''' Aufruf bei Einfügen über Clipboard
    ''' </summary>
    Private Function CanInsert(ByVal s As String) As Boolean

        Try
            Dim d As Decimal = Decimal.Parse(s)
            s = d.ToString
            If (d < 0) AndAlso (Not MinusAllowed) Then
                Return False
            End If
            s = s.Replace("-", "")
            Dim k() As String = s.Split(","c)
            If k.GetUpperBound(0) > 1 Then
                Return False
            End If
            If k(0).Length > m_DigitsBeforePoint Then
                Return False
            End If
            If k.GetUpperBound(0) = 1 Then
                If k(1).Length > m_DigitsAfterPoint Then
                    Return False
                End If
            End If
            Return True
        Catch ex As Exception
            Return False
        End Try
    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.