RestrictText.vb

RestrictText.vb

Option Strict On
Imports System
Imports System.Diagnostics
Imports System.Runtime.InteropServices
Imports System.Text
Imports System.Windows.Forms

Public Class RestrictText
    Inherits TextBox
    Private Const CTRL_A As Char = ChrW(&H1)    ' CTRL+A (Select All)
    Private Const CTRL_C As Char = ChrW(&H3)    ' CTRL+C (Copy)
    Private Const CTRL_V As Char = ChrW(&H16)   ' CTRL+V (Paste)
    Private Const CTRL_X As Char = ChrW(&H18)   ' CTRL+X (Cut)
    Private Const CTRL_Z As Char = ChrW(&H1A)   ' CTRL+Z (Undo)

    Private _CanRaiseEvents As Boolean = True

    ''' <summary>
    ''' Determines whether the character is allowed to input.
    ''' </summary>
    ''' <param name="inputChar">input character</param>
    ''' <returns>true if input is allowed, false otherwise.</returns>
    Protected Overridable Function IsAllowChar(inputChar As Char) As Boolean
        Return True
    End Function

    ''' <summary>
    ''' Determines whether the text is valid when character input is allowed.
    ''' </summary>
    ''' <param name="reflectsText">Text that reflects character input</param>
    ''' <returns>true if input is allowed, false otherwise.</returns>
    Protected Overridable Function IsValidText(reflectsText As String) As Boolean
        Return MaxLength = 0 OrElse reflectsText.Length <= MaxLength
    End Function

    Protected Overrides Sub OnReadOnlyChanged(e As EventArgs)
        MyBase.OnReadOnlyChanged(e)
        If Me.ReadOnly Then
            ClearUndo()
        End If
    End Sub

    Protected Overrides Sub OnKeyDown(e As KeyEventArgs)
        Dim valid As Boolean = True
        Dim left As String = Nothing
        Dim right As String = Nothing
        Select Case e.KeyCode
            Case Keys.Delete
                GetUnSelectedText(left, right)
                If SelectionLength > 0 Then
                    valid = IsValidText(left & right)
                Else
                    If right.Length > 0 Then
                        valid = IsValidText(left & right.Substring(1))
                    End If
                End If
        End Select
        If Not valid Then
            e.Handled = True
            e.SuppressKeyPress = True
            Return
        End If
        MyBase.OnKeyDown(e)
    End Sub

    Protected Sub GetUnSelectedText(ByRef left As String, ByRef right As String)
        Dim prevText As String = MyBase.Text
        left = prevText.Substring(0, SelectionStart)
        right = prevText.Substring(SelectionStart + SelectionLength)
    End Sub

    Protected Overrides Sub OnKeyPress(e As KeyPressEventArgs)
        Dim valid As Boolean = True
        Dim left As String = Nothing
        Dim right As String = Nothing
        Select Case e.KeyChar
            Case ControlChars.Back
                GetUnSelectedText(left, right)
                If SelectionLength > 0 Then
                    valid = IsValidText(left & right)
                Else
                    If left.Length > 0 Then
                        valid = IsValidText(left.Substring(0, left.Length - 1) & right)
                    End If
                End If
            Case CTRL_A, CTRL_C, CTRL_V, CTRL_X, CTRL_Z
            Case Else
                If IsAllowChar(e.KeyChar) Then
                    GetUnSelectedText(left, right)
                    Dim checkText As StringBuilder = StringBuilderCache.Acquire()
                    checkText.Append(left)
                    checkText.Append(e.KeyChar)
                    checkText.Append(right)
                    valid = IsValidText(StringBuilderCache.GetStringAndRelease(checkText))
                Else
                    valid = False
                End If
        End Select
        If Not valid Then
            e.Handled = True
            Return
        End If
        MyBase.OnKeyPress(e)
    End Sub

    <DebuggerStepThrough>
    Protected Overrides Sub WndProc(ByRef m As Message)
        Select Case m.Msg
            Case WM_CUT
                WmCut(m)
            Case WM_CLEAR
                WmClear(m)
            Case WM_COPY
                MyBase.WndProc(m)
            Case WM_PASTE
                WmPaste(m)
            Case WM_UNDO, EM_UNDO
                WmUndo(m)
            Case Else
                MyBase.WndProc(m)
        End Select
    End Sub

    Private Sub WmCut(ByRef m As Message)
        Dim left As String = Nothing
        Dim right As String = Nothing
        GetUnSelectedText(left, right)
        If IsValidText(left & right) Then
            MyBase.WndProc(m)
        End If
    End Sub

    Private Sub WmClear(ByRef m As Message)
        Dim left As String = Nothing
        Dim right As String = Nothing
        GetUnSelectedText(left, right)
        If IsValidText(left & right) Then
            MyBase.WndProc(m)
        End If
    End Sub

    Private Sub WmPaste(ByRef m As Message)
        If Not Clipboard.ContainsText() Then
            Return
        End If
        Dim left As String = Nothing
        Dim right As String = Nothing
        GetUnSelectedText(left, right)
        Dim pasteText As StringBuilder = StringBuilderCache.Acquire()
        For Each c As Char In Clipboard.GetText()
            If IsAllowChar(c) Then
                Dim checkText As StringBuilder = StringBuilderCache.Acquire()
                checkText.Append(left)
                checkText.Append(pasteText.ToString())
                checkText.Append(c)
                checkText.Append(right)
                If IsValidText(StringBuilderCache.GetStringAndRelease(checkText)) Then
                    pasteText.Append(c)
                End If
            End If
        Next
        If pasteText.Length > 0 Then
            Paste(StringBuilderCache.GetStringAndRelease(pasteText))
        Else
            StringBuilderCache.Release(pasteText)
        End If
        m.Result = IntPtr.Zero
    End Sub

    Private Sub WmUndo(ByRef m As Message)
        LockWindowUpdate(m.HWnd)
        Try
            Dim prevText As String = MyBase.Text
            MyBase.WndProc(m)
            If Not IsValidText(MyBase.Text) Then
                SetTextWithoutEvents(prevText)
            End If
        Finally
            LockWindowUpdate(IntPtr.Zero)
            Invalidate()
        End Try
    End Sub

    Protected Overrides ReadOnly Property CanRaiseEvents As Boolean
        Get
            Return _CanRaiseEvents
        End Get
    End Property

    Protected Sub SetTextWithoutEvents(value As String)
        If MyBase.Text <> value Then
            _CanRaiseEvents = False
            Try
                MyBase.Text = value
            Finally
                _CanRaiseEvents = True
            End Try
        End If
    End Sub

    Protected Overrides Sub OnEnter(e As EventArgs)
        OnBeforeEnter(e)
        MyBase.OnEnter(e)
    End Sub

    Protected Overridable Sub OnBeforeEnter(e As EventArgs)
        SetTextWithoutEvents(UnFormat(MyBase.Text))
        SelectAll()
    End Sub

    Protected Overrides Sub OnLeave(e As EventArgs)
        OnBeforeLeave(e)
        MyBase.OnLeave(e)
    End Sub

    Protected Overridable Sub OnBeforeLeave(e As EventArgs)
        SetTextWithoutEvents(Format(MyBase.Text))
    End Sub

    Protected Overridable Function UnFormat(value As String) As String
        Dim sb As StringBuilder = StringBuilderCache.Acquire()
        For Each c As Char In value
            If IsAllowChar(c) Then
                sb.Append(c)
            End If
        Next
        Return StringBuilderCache.GetStringAndRelease(sb)
    End Function

    Protected Overridable Function Format(value As String) As String
        Return value
    End Function

    ' Sorry, Microsoft development team. And thx.
    ' It's such a great class that I couldn't help but copy it.
    Protected Class StringBuilderCache
        Private Const MAX_BUILDER_SIZE As Integer = 360
        Private Const DefaultCapacity As Integer = 16

        <ThreadStatic>
        Private Shared CachedInstance As StringBuilder

        Public Shared Function Acquire(Optional capacity As Integer = DefaultCapacity) As StringBuilder
            If capacity <= MAX_BUILDER_SIZE Then
                Dim sb As StringBuilder = CachedInstance
                If sb IsNot Nothing Then
                    If capacity <= sb.Capacity Then
                        CachedInstance = Nothing
                        sb.Clear()
                        Return sb
                    End If
                End If
            End If
            Return New StringBuilder(capacity)
        End Function

        Public Shared Sub Release(sb As StringBuilder)
            If sb.Capacity <= MAX_BUILDER_SIZE Then
                CachedInstance = sb
            End If
        End Sub

        Public Shared Function GetStringAndRelease(sb As StringBuilder) As String
            Dim result As String = sb.ToString()
            Release(sb)
            Return result
        End Function
    End Class

    Private Class ExternDll
        Public Const User32 As String = "user32.dll"
    End Class

    Private Const WM_CUT As Integer = &H300
    Private Const WM_COPY As Integer = &H301
    Private Const WM_PASTE As Integer = &H302
    Private Const WM_CLEAR As Integer = &H303
    Private Const WM_UNDO As Integer = &H304

    Private Const EM_UNDO As Integer = &HC7

    <DllImport(ExternDll.User32)>
    Private Shared Function LockWindowUpdate(hWndLock As IntPtr) As Boolean
    End Function
End Class