カスタムテキストボックスは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
