Top / JUNK / RestrictTextBox

入力キャラクタを制限するテキストボックス。 IsValidText や IsValidChar をオーバーライドしてカスタマイズします。

Imports System
Imports System.Runtime.InteropServices
Imports System.Text
Imports System.Windows.Forms

Namespace Global.Koz.Fx.Windows.Forms

    ''' <summary>
    ''' 入力キャラクタを制限するテキストボックス。 
    ''' IsValidText メソッドや IsValidChar メソッドをオーバーライドしてカスタマイズします。
    ''' </summary>
    Public Class RestrictTextBox
        Inherits TextBox

        Private Const WM_PASTE As Integer = 770
        Private Const EM_GETSEL As Integer = 176

        Private Const CTRL_A As Char = ChrW(1)
        Private Const CTRL_C As Char = ChrW(3)
        Private Const CTRL_V As Char = ChrW(22)
        Private Const CTRL_X As Char = ChrW(24)
        Private Const CTRL_Z As Char = ChrW(26)

        <DllImport("User32", CharSet:=CharSet.Unicode)>
        Private Shared Function SendMessage(hwnd As HandleRef, msg As Integer, ByRef wParam As Integer, ByRef lParam As Integer) As IntPtr
        End Function

        <DllImport("User32", CharSet:=CharSet.Unicode)>
        Private Shared Function GetWindowTextLength(hwnd As HandleRef) As Integer
        End Function

        <DllImport("User32", CharSet:=CharSet.Unicode)>
        Private Shared Function GetWindowText(hwnd As HandleRef, lpString As StringBuilder, nMaxCount As Integer) As Integer
        End Function

        ''' <summary>
        ''' テキストを分解した結果
        ''' </summary>
        Protected Structure Decompose
            Public Left As String
            Public Selected As String
            Public Right As String
        End Structure

        ''' <summary>
        ''' テキストボックスのテキストをキャレットを境に左右に分解
        ''' </summary>
        Protected Function DecomposeTextAtCaret() As Decompose
            Dim d As New Decompose()

            'テキスト長を取得
            Dim hwnd As New HandleRef(Me, Handle)
            Dim allLength As Integer = GetWindowTextLength(hwnd)

            If allLength > 0 Then
                ' ゼロでなければ取得
                Dim allText As New StringBuilder(allLength * 2 + 1)
                GetWindowText(hwnd, allText, allText.Capacity)

                ' Selection 〜 プロパティは取得するたびに EM_GETSEL を送るので一発で取得
                Dim nStart As Integer = 0
                Dim nEnd As Integer = 0
                SendMessage(hwnd, EM_GETSEL, nStart, nEnd)

                ' テキストを分解
                d.Left = allText.ToString(0, nStart)
                d.Selected = allText.ToString(nStart, nEnd - nStart)
                d.Right = allText.ToString(nEnd, allLength - nEnd)
            Else
                ' ゼロなら空をセット
                d.Left = String.Empty
                d.Selected = String.Empty
                d.Right = String.Empty
            End If
            Return d
        End Function

        Protected Overrides Sub OnKeyDown(e As KeyEventArgs)
            Select Case e.KeyCode
                Case Keys.Delete
                    ' 文字が選択されていなければ右側の先頭1文字が削除される
                    Dim d As Decompose = DecomposeTextAtCaret()
                    If d.Selected.Length = 0 AndAlso d.Right.Length > 0 Then
                        d.Selected = d.Right.Substring(0, 1)
                        d.Right = d.Right.Substring(1)
                    End If
                    e.Handled = Not TryRemoveText(d)
                    e.SuppressKeyPress = e.Handled
            End Select
            MyBase.OnKeyDown(e)
        End Sub

        Protected Overrides Sub OnKeyPress(e As KeyPressEventArgs)
            Select Case e.KeyChar
                Case CTRL_A
                    ' すべて選択
                    Me.SelectAll()
                    e.Handled = True

                Case CTRL_C, CTRL_V, CTRL_Z
                    ' Copy は無条件に OK
                    ' WM_PASTE でチェック
                    ' Undo は無条件に OK

                Case CTRL_X
                    ' 切り取り
                    Dim d As Decompose = DecomposeTextAtCaret()
                    If d.Selected.Length > 0 Then
                        e.Handled = Not TryRemoveText(d)
                    End If
                Case ControlChars.Back
                    ' BackSpace
                    Dim d As Decompose = DecomposeTextAtCaret()
                    ' 文字が選択されていなければ左側の最後の1文字が削除される
                    If d.Selected.Length = 0 AndAlso d.Left.Length > 0 Then
                        d.Selected = d.Left.Substring(d.Left.Length - 1, 1)
                        d.Left = d.Left.Substring(0, d.Left.Length - 1)
                    End If
                    e.Handled = Not TryRemoveText(d)
                Case Else
                    ' キャラクタをチェック
                    Dim c = e.KeyChar
                    If IsValidChar(c) Then
                        Dim d As Decompose = DecomposeTextAtCaret()
                        If IsValidText(d.Left & Convert.ToString(c) & d.Right) Then
                            e.KeyChar = c
                        Else
                            e.Handled = True
                        End If
                    Else
                        e.Handled = True
                    End If
            End Select
            MyBase.OnKeyPress(e)
        End Sub

        ''' <summary>
        ''' 選択文字を削除した結果が正しいか検証します。
        ''' </summary>
        Protected Overridable Function TryRemoveText(d As Decompose) As Boolean
            Return IsValidText(d.Left & d.Right)
        End Function

        ''' <summary>
        ''' 編集後の文字列が妥当か判定します。
        ''' </summary>
        Protected Overridable Function IsValidText(value As String) As Boolean
            Return True
        End Function

        ''' <summary>
        ''' 入力キャラクタを制限します。
        ''' 必要があれば変換を行います。
        ''' </summary>
        Protected Overridable Function IsValidChar(ByRef c As Char) As Boolean
            Return True
        End Function

        Protected Overrides Sub WndProc(ByRef m As Message)
            Select Case m.Msg
                Case WM_PASTE
                    WmPaste()
                Case Else
                    MyBase.WndProc(m)
            End Select
        End Sub

        Private Sub WmPaste()

            ' クリップボードにテキストが無ければ何もしない
            If Not Clipboard.ContainsText() Then
                Return
            End If

            ' 貼り付け可能な文字数を計算
            Dim d As Decompose = DecomposeTextAtCaret()
            Dim pasteMaxLength As Integer = 0
            If MaxLength > 0 Then
                pasteMaxLength = MaxLength - d.Left.Length - d.Right.Length
            Else
                pasteMaxLength = Integer.MaxValue - d.Left.Length - d.Right.Length
            End If

            ' ひと文字ずつチェック
            Dim clipText As String = Clipboard.GetText()
            Dim sb = New StringBuilder(clipText.Length)
            Dim i As Integer = 0
            While i <= clipText.Length - 1 OrElse sb.Length >= pasteMaxLength
                Dim c As Char = clipText(i)
                If IsValidChar(c) Then
                    If IsValidText(d.Left & sb.ToString() & c & d.Right) Then
                        sb.Append(c)
                    End If
                End If
                i += 1
            End While
            If sb.Length > 0 Then
                MyBase.Paste(sb.ToString())
            End If
        End Sub

        Private _CanRaiseEvents As Boolean = True

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

        Protected Sub SetCanRaiseEvents(value As Boolean)
            _CanRaiseEvents = value
        End Sub
    End Class

End Namespace



トップ   編集 凍結 差分 バックアップ 添付 複製 名前変更 リロード   新規 一覧 単語検索 最終更新   最終更新のRSS
Last-modified: 2020-02-25 (火) 17:56:37 (39d)