投稿者 shu  (社会人) 投稿日時 2011/7/5 22:00:12
ImeON状態、入力チェックについては魔界の仮面弁士が示されているように
RegularExpressionsでひらがなかチェックすればよいです。

Disableでローマ字入力限定版でのサンプルです。変換マップはかなり歯抜けに
なってますので埋めて下さい。アルファベットの昇順で定義しないとちゃんと動きません。
会社で使っているものとは別に作りましたので動作はそれほどでしっかりしていません。
キーボードからのローマ字入力限定です。

Public Class RomanTextBox
    Inherits TextBox

    Private RomanMap(,) As String = {{"", "あ", "い", "う", "え", "お"},
                        {"GY", "ぎゃ", "", "ぎゅ", "", "ぎょ"},
                        {"K", "か", "き", "く", "け", "こ"},
                        {"N", "な", "に", "ぬ", "ね", "の"},
                        {"S", "さ", "し", "す", "せ", "そ"},
                        {"T", "た", "ち", "つ", "て", "と"}}

    Public Sub New()
        MyBase.New()
        MyBase.ImeModeBase = Windows.Forms.ImeMode.Disable
        MyBase.CharacterCasing = Windows.Forms.CharacterCasing.Upper
    End Sub

    Protected Overrides Property ImeModeBase As System.Windows.Forms.ImeMode
        Get
            Return MyBase.ImeModeBase
        End Get
        Set(ByVal value As System.Windows.Forms.ImeMode)
            MyBase.ImeModeBase = ImeMode.Disable
        End Set
    End Property

    Private Sub RomanTextBox_KeyPress(ByVal sender As Object, ByVal e As System.Windows.Forms.KeyPressEventArgs) Handles Me.KeyPress
        Select Case e.KeyChar
            Case "A"c, "a"c
                e.KeyChar = TransRoman(1)
            Case "I"c, "i"c
                e.KeyChar = TransRoman(2)
            Case "U"c, "u"c
                e.KeyChar = TransRoman(3)
            Case "E"c, "e"c
                e.KeyChar = TransRoman(4)
            Case "O"c, "o"c
                e.KeyChar = TransRoman(5)
            Case "N"c, "n"c
                If IsNN Then
                    e.KeyChar = "ん"c
                End If
            Case "A"c To "Z"c, "a"c To "z"c
            Case vbBack
            Case Else
                e.Handled = True
        End Select
    End Sub

    Private Function TransRoman(ByVal idx As Integer) As Char
        Dim SelSt = MyBase.SelectionStart
        Dim SelLen = MyBase.SelectionLength
        Dim Bef = If(SelSt > 0, MyBase.Text.Substring(0, SelSt), MyBase.Text)
        Dim Aft = If(SelSt + SelLen < TextLength, MyBase.Text.Substring(SelSt + SelLen), "")

        Dim Trg As String = ""

        If Bef <> "" Then
            For Each chr1 In Bef
                Select Case chr1
                    Case "A"c To "Z"c, "a"c To "z"c
                        Trg &= chr1.ToString.ToUpper
                End Select
            Next
            If Trg.Length > 0 Then
                Bef = Bef.Substring(0, Bef.Length - Trg.Length)
            End If
        End If