カスタムテキストボックスはImeが確定するとフリガナを取得し、KanaCommitedイベントを発生します。
フリガナは半角カナと数字のみを取り出します。
CustomTextBox1スに入力した文字列より振り仮名を取得し、
TextBox1に表示します。
Public Class Form1 Private Sub CustomTextBox1_KanaCommitted(ByVal e As KanaEventArgs) _ Handles CustomTextBox1.KanaCommitted If e.Cancel Then Me.TextBox1.Text = String.Empty Else Me.TextBox1.Text = Me.TextBox1.Text & e.Kana End If End Sub End Class
カスタムテキストボックスです。
Imports System.Runtime.InteropServices Public Class CustomTextBox Inherits System.Windows.Forms.TextBox '-----API定義----- Private Const WM_IME_COMPOSITION As Integer = &H10F Private Const WM_CHAR As Integer = &H102 Private Const GCS_RESULTREADSTR As Integer = &H200 <DllImport("Imm32.dll", CharSet:=CharSet.Ansi)> _ Private Shared Function ImmGetContext(ByVal hWnd As IntPtr) As IntPtr End Function <DllImport("Imm32.dll", CharSet:=CharSet.Ansi)> _ Private Shared Function ImmReleaseContext(ByVal hWnd As IntPtr, ByVal hIMC As IntPtr) As Integer End Function <DllImport("Imm32.dll", CharSet:=CharSet.Ansi)> _ Private Shared Function ImmGetCompositionString(ByVal hIMC As IntPtr, ByVal dwIndex As Integer, ByVal lpBuf As System.Text.StringBuilder, ByVal dwBufLen As Integer) As Integer End Function <DllImport("Imm32.dll", CharSet:=CharSet.Ansi)> _ Private Shared Function ImmGetOpenStatus(ByVal hIMC As IntPtr) As Integer End Function '-----イベント定義----- Public Event KanaCommitted(ByVal e As KanaEventArgs) '-----Protectedメソッド----- Protected Overrides Sub WndProc(ByRef m As System.Windows.Forms.Message) Dim handled As Boolean = False Select Case m.Msg Case WM_IME_COMPOSITION Dim strFurigana As String = "" Dim hIMC As IntPtr = ImmGetContext(Me.Handle) Try '-- ふりがな文字列 Dim intLength As Integer = ImmGetCompositionString(hIMC, GCS_RESULTREADSTR, Nothing, 0) If intLength > 0 Then Dim str As New System.Text.StringBuilder(intLength) ImmGetCompositionString(hIMC, GCS_RESULTREADSTR, str, intLength) strFurigana = str.ToString If strFurigana.Length > intLength Then strFurigana = strFurigana.Substring(0, intLength) End If 'イベント起動 Dim ev As New KanaEventArgs(strFurigana, False) OnKanaCommited(ev) End If Finally ImmReleaseContext(Me.Handle, hIMC) End Try Case WM_CHAR '半角英数字 Dim hIMC As IntPtr = ImmGetContext(Me.Handle) Try If ImmGetOpenStatus(hIMC) = 0 Then If m.WParam.ToInt32 >= 32 Then 'イベント起動 Dim ev As New KanaEventArgs(Chr(m.WParam.ToInt32), False) OnKanaCommited(ev) End If End If Finally ImmReleaseContext(Me.Handle, hIMC) End Try End Select If Not handled Then MyBase.WndProc(m) End Sub Protected Overridable Sub OnKanaCommited(ByVal e As KanaEventArgs) 'カナを取得する場合は '--IMEの入力文字より半角カナと数字以外を除去します。 If Not String.IsNullOrEmpty(e.Kana) Then e.Kana = GetMatchRegexString(e.Kana, "[ヲ-゚]|[0-9]") End If '--仮名確定イベントを起動します。 RaiseEvent KanaCommitted(e) End Sub '-----Privateメソッド----- ''' <summary> ''' 文字列から許可された文字を連結して取得します。 ''' </summary> ''' <param name="target">検査する文字列</param> ''' <param name="pattern">許可するパターン</param> ''' <returns>引数に指定した文字列から許可された文字だけを連結して返します。</returns> ''' <remarks> ''' </remarks> Private Shared Function GetMatchRegexString(ByVal target As String, ByVal pattern As String) As String If pattern = String.Empty Then Return target End If Dim stReturn As String = String.Empty For Each chTarget As Char In target If IsMatchRegexPattern(chTarget, pattern) Then stReturn &= chTarget End If Next chTarget Return stReturn End Function ''' <summary> ''' 文字が許可するパターンかどうかを検査します。 ''' </summary> ''' <param name="target">検査する文字</param> ''' <param name="pattern">許可するパターン</param> ''' <returns>引数に指定した検査する文字が、引数に指定した許可するパターンであればTrue、それ以外はFalse。</returns> ''' <remarks> ''' </remarks> Private Shared Function IsMatchRegexPattern(ByVal target As Char, ByVal pattern As String) As Boolean If pattern = String.Empty OrElse System.Text.RegularExpressions.Regex.IsMatch(target, pattern) Then Return True End If End Function End Class
カスタムテキストボックスが発生させるKanaCommittedイベントのイベントデータクラスです。
Public Class KanaEventArgs Inherits EventArgs '-----Private変数----- ''' <summary>仮名</summary> Private _sKana As String ''' <summary>振り仮名がキャンセルされたかどうか</summary> Private _isCancel As Boolean '-----コンストラクタ------ Public Sub New() End Sub Public Sub New(ByVal sKana As String, ByVal isCancel As Boolean) Me._sKana = sKana Me._isCancel = isCancel End Sub '-----Publicプロパティ----- ''' <summary> ''' 仮名を取得および設定します。 ''' </summary> ''' <value></value> ''' <returns></returns> ''' <remarks></remarks> Public Property Kana() As String Get Return Me._sKana End Get Set(ByVal value As String) Me._sKana = value End Set End Property ''' <summary> ''' 振り仮名がキャンセルされたかどうかを取得および設定します。 ''' ※テキストボックスの値がクリアされたときTrueになります。 ''' </summary> ''' <value></value> ''' <returns></returns> ''' <remarks></remarks> Public Property Cancel() As Boolean Get Return Me._isCancel End Get Set(ByVal value As Boolean) Me._isCancel = value End Set End Property End Class
0 件のコメント:
コメントを投稿