| 日時: 2017/07/03 19:17名前: 魔界の仮面弁士
 
************************************************************************************ カテゴリー:[テキストボックス][][]
 * キーワード: 読み仮名, フリガナ, 漢字変換, , ,
 ***********************************************************************************
 
 ※ VB.NET 掲示板 No11851 への回答を兼ねています。
 
 プロジェクトに新規クラス(YomiganaTextBox.vb)を追加してコンパイルすると、
 ツールボックスに YomiganaTextBox というテキストボックスが追加されます。
 
 
 フォームに YomiganaTextBox を配置した後、その YomiganaControl プロパティに、
 カナを表示させるコントロール(TextBox や Label 等)を配置しておけば、
 漢字変換時に、読み仮名が自動的にセットされます。
 
 
 Option Strict On
 Imports System
 Imports System.ComponentModel
 Imports System.IO
 Imports System.Runtime.InteropServices
 Imports System.Text
 Imports System.Windows.Forms
 
 Public Class YomiganaTextBox
 Inherits System.Windows.Forms.TextBox
 
 ''' <summary>
 ''' 取得された確定文字列を読み仮名に変換する方法を提供します。
 ''' 既定では半角カタカナとして取得されますが、ひらがなやカタカナを返すようにしたい場合は、
 ''' このメソッドをオーバーライドしてください。
 ''' </summary>
 ''' <param name="input">
 ''' かな漢字変換時に取得された確定文字列。
 ''' 漢字変換中に確定前文字列が編集された場合は、ここに漢字等が混入する可能性があります。
 ''' </param>
 ''' <returns>
 ''' <see cref="YomiganaControl"/> に渡される読み仮名。
 ''' </returns>
 Protected Overridable Function ConvertPerKanaMode(ByVal input As String) As String
 'Debug.WriteLine(input)
 If IsAllNarrow(StrConv(input, VbStrConv.Narrow)) Then
 Return StrConv(input, VbStrConv.Narrow Or VbStrConv.Katakana)
 Else
 Return input
 End If
 End Function
 
 ''' <summary>読み仮名を自動入力させるコントロールを取得または設定します。</summary>
 <Category("Appearance"), DefaultValue(DirectCast(Nothing, Control))> _
 Public Property YomiganaControl() As Control
 Get
 Return _yomiganaControl
 End Get
 Set(ByVal value As Control)
 If value IsNot Me Then
 _yomiganaControl = value
 End If
 End Set
 End Property
 Private _yomiganaControl As Control = Nothing
 
 Protected Overrides Sub WndProc(ByRef m As Message)
 '
 'WParam … Win16では16ビット長、Win32では32ビット長、Win64では64ビット長
 'LParam … Win16とWin32では32ビット長、Win64では64ビット長
 '
 Select Case m.Msg
 Case NativeMethods.WM_IME_COMPOSITION   'IME入力中に読み仮名を得る
 If YomiganaControl Is Nothing Then
 Exit Select
 End If
 '
 '【WM_IME_COMPOSITION】
 '    IMEがキー入力の結果として、コンポジション状態を変更するとき、アプリに送信されます。
 '  WParam:
 '    コンポジション文字列への最後の変更を表すDBCS文字を示します。
 '  LParam:
 '    どのようにコンポジション文字列が変更されたかを表す値を示します。
 '
 If (ToUInt32(m.LParam) And NativeMethods.GCS_RESULTREADSTR) <> 0UI Then
 '読み仮名を取得
 Dim compositionString As String = GetCompositionString(NativeMethods.GCS_RESULTREADSTR)
 Dim yomigana As String = ConvertPerKanaMode(compositionString)
 
 '読み仮名の挿入位置を判断
 If MyBase.SelectionStart = 0 Then
 '先頭の場合は読み仮名も先頭に追加
 YomiganaControl.Text = yomigana & YomiganaControl.Text
 Else
 '末尾に読み仮名を追加
 YomiganaControl.Text &= yomigana
 End If
 End If
 Case NativeMethods.WM_CHAR  '半角英語
 If YomiganaControl Is Nothing Then
 Exit Select
 End If
 '
 '【WM_CHAR】
 '    キー操作が非システムキャラクタに変換されたときにウィンドウにポストされます。
 '  WParam:
 '    入力された非システム文字のキャラクタコードを示します。
 '  LParam:
 '    0〜15bit:
 '      このメッセージのキーリピート数を示します。
 '      これは、ユーザーがキーを押し続けたことにより自動的に繰り返されたキーストロークの回数です。
 '      キーが十分に長く押され続けた場合は複数のメッセージが送られますが、カウントは累積されません。
 '    16〜23bit:
 '      OEM 依存のスキャンコードを示します。
 '    24bit:
 '      [右Alt]キーや[Ctrl]キーなどといった、拡張キーが押されたかどうかを示します。
 '      拡張キーの場合は 1 が、それ以外のキーでは 0 が格納されます。
 '    25〜28bit:
 '      使用されません。
 '    29bit:
 '      コンテキストコードを示します。
 '      [Alt] キーを押した状態でほかのキーを押した場合は 1 が、それ以外の場合は 0 が格納されます。
 '    30bit:
 '      直前のキー状態を示します。
 '      メッセージが送られる前にキーが押されていた場合は 1 が、離されていた場合は 0 が格納されます。
 '    31bit:
 '      変換状態が指定されます。
 '      キーが離されている場合は 1 が、押されてる場合は 0 が格納されます。
 If IsImeClosed() AndAlso ToUInt32(m.WParam) >= 32UI Then
 '制御キャラクタは無視します
 Dim ch As String = ChrW(ToInt32(m.WParam)).ToString()
 Dim yomigana As String = ConvertPerKanaMode(ch)
 YomiganaControl.Text &= ch  '末尾に追加
 End If
 Case NativeMethods.WM_KEYUP     '操作キー(連動消去)
 '
 '【WM_KEYUP】
 '    押されていた非システムキーが離された場合に、キーボードフォーカスを持つウィンドウにポストされます。
 '    非システムキーとは、 [Alt] キーが押されていないときに押されたキーのことです。
 '  WParam:
 '    非システムキーの仮想キーコードが指定されます。
 '  LParam:
 '    0〜15bit:
 '      このメッセージのキーリピート数を示します。常に 1 固定です。
 '    16〜23bit:
 '      OEM 依存のスキャンコードを示します。
 '    24bit:
 '      [右Alt]キーや[Ctrl]キーなどといった、拡張キーが押されたかどうかを示します。
 '      拡張キーの場合は 1 が、それ以外のキーでは 0 が格納されます。
 '    25〜28bit:
 '      使用されません。
 '    29bit:
 '      コンテキストコードを示します。常に 0 固定です。
 '    30bit:
 '      直前のキー状態を示します。常に 1 固定です。
 '    31bit:
 '      変換状態が指定されます。常に 1 固定です。
 '
 Dim vk As Keys = DirectCast(ToInt32(m.WParam), Keys)
 If vk = Keys.Back OrElse vk = Keys.Delete Then
 'キーでの削除監視
 If TextLength = 0 AndAlso YomiganaControl IsNot Nothing Then
 YomiganaControl.Text = ""
 End If
 End If
 End Select
 MyBase.WndProc(m)
 End Sub
 
 Private Shared Function ToInt32(ByVal p As IntPtr) As Integer
 Dim us As UInteger = ToUInt32(p)
 If (us And &H80000000UI) = 0UI Then
 Return CInt(us)
 Else
 Return CInt(CLng(us) - CLng(UInteger.MaxValue) - 1L)
 End If
 End Function
 
 Private Shared Function ToUInt32(ByVal p As IntPtr) As UInteger
 Return System.Convert.ToUInt32(p.ToInt64() And &HFFFFFFFFL)
 End Function
 
 Private Function IsImeClosed() As Boolean
 Dim hImc As IntPtr = IntPtr.Zero
 Try
 hImc = NativeMethods.ImmGetContext(Handle)
 If hImc <> IntPtr.Zero Then
 Return Not NativeMethods.ImmGetOpenStatus(hImc)
 End If
 Finally
 If hImc = IntPtr.Zero Then
 NativeMethods.ImmReleaseContext(Handle, hImc)
 End If
 End Try
 Return True
 End Function
 
 Private Function GetCompositionString(ByVal flags As UInteger) As String
 Dim result As String = String.Empty
 Dim hImc As IntPtr = IntPtr.Zero
 Try
 hImc = NativeMethods.ImmGetContext(Handle)
 If hImc = IntPtr.Zero Then
 Exit Try
 End If
 Dim dwSize As Integer = NativeMethods.ImmGetCompositionString(himc, flags, Nothing, 0)
 If dwSize > 0 Then
 'ImmGetCompositionString は、文字数ではなくバイト数で返却するので、
 'StringBuilder は使わずに自前で処理する
 Dim buffer As Byte() = New Byte(dwSize - 1) {}
 dwSize = NativeMethods.ImmGetCompositionString(himc, flags, buffer, dwSize)
 result = Encoding.Unicode.GetString(buffer)
 End If
 Finally
 If hImc = IntPtr.Zero Then
 NativeMethods.ImmReleaseContext(Handle, hImc)
 End If
 End Try
 Return result
 End Function
 
 Private Shared Function IsAllNarrow(ByVal text As String) As Boolean
 For Each c As Char In text
 Dim n As Integer = Asc(c)
 If n < 0 OrElse n > 255 Then
 Return False
 End If
 Next
 Return True
 End Function
 
 #Region "API"
 Private Class NativeMethods
 '// HIMC ImmGetContext(
 '//   _In_ HWND hWnd
 '// );
 Friend Declare Unicode Function ImmGetContext Lib "imm32" (ByVal hWnd As IntPtr) As IntPtr
 
 '// LONG ImmGetCompositionString(
 '//   _In_      HIMC   hIMC,
 '//   _In_      DWORD  dwIndex,
 '//   _Out_opt_ LPVOID lpBuf,
 '//   _In_      DWORD  dwBufLen
 '// );
 Friend Declare Unicode Function ImmGetCompositionString Lib "imm32" Alias "ImmGetCompositionStringW" (ByVal hIMC As IntPtr, ByVal dwIndex As UInteger, ByVal lpBuf As Byte(), ByVal dwBufLen As Integer) As Integer
 
 '// BOOL ImmReleaseContext(
 '//   _In_ HWND hWnd,
 '//   _In_ HIMC hIMC
 '// );
 Friend Declare Unicode Function ImmReleaseContext Lib "Imm32" (ByVal hWnd As IntPtr, ByVal hIMC As IntPtr) As <MarshalAs(UnmanagedType.Bool)> Boolean
 
 
 '// BOOL WINAPI ImmGetOpenStatus(
 '//   HIMC hIMC
 '// );
 Friend Declare Unicode Function ImmGetOpenStatus Lib "Imm32" (ByVal hWnd As IntPtr) As <MarshalAs(UnmanagedType.Bool)> Boolean
 
 Public Const WM_KEYUP As Integer = &H101
 Public Const WM_CHAR As Integer = &H102
 Public Const WM_IME_COMPOSITION As Integer = &H10F
 
 #Region "WM_IME_COMPOSITION の LPRAM 用"
 ''' <summary>入力された文字列を1バイトカタカナで表した文字列をbufに返す。戻り値は、文字列のバイトサイズ。</summary>
 Public Const GCS_COMPREADSTR As UInteger = &H1UI
 
 ''' <summary>変換途中の文字列中の各文字の属性を示す8bit整数のフラグの配列が、bufに返される。戻り値は、配列のバイトサイズ。</summary>
 ''' <remarks>返される配列の値は、ATTR_ 系定数を示す。</remarks>
 Public Const GCS_COMPREADATTR As UInteger = &H2UI
 
 ''' <summary>各文節の位置を文字数で表す、32bit整数のオフセット値の配列が、bufに返される。ただし、配列の末尾に、入力されている文字列長を文字数で表した値が格納される。戻り値は配列のバイトサイズ。</summary>
 Public Const GCS_COMPREADCLAUSE As UInteger = &H4UI
 
 ''' <summary>入力されている文字列をbufに返す。戻り値は、文字列のバイトサイズ。</summary>
 Public Const GCS_COMPSTR As UInteger = &H8UI
 
 ''' <summary>入力されている文字列中の各バイト値の属性を表す8bit整数フラグの配列がbufに返される。すなわち、2バイト文字の第二バイトの属性情報も返される。戻り値は、配列の要素数。</summary>
 ''' <remarks>返される配列の値は、ATTR_ 系定数を示す。</remarks>
 Public Const GCS_COMPATTR As UInteger = &H10UI
 
 ''' <summary>入力されている文字列をbufに返す。戻り値は、文字列のバイトサイズ。</summary>
 Public Const GCS_COMPCLAUSE As UInteger = &H20UI
 
 ''' <summary>戻り値は、現在のカーソル位置。</summary>
 Public Const GCS_CURSORPOS As UInteger = &H80UI
 
 ''' <summary>戻り値は、最後に変更がされた文字列の先頭位置。</summary>
 Public Const GCS_DELTASTART As UInteger = &H100UI
 
 ''' <summary>最後に変換を行った際に入力された文字列を1バイトカタカナで表した文字列をbufに返す。戻り値は、文字列のバイトサイズ。</summary>
 Public Const GCS_RESULTREADSTR As UInteger = &H200UI
 
 ''' <summary>最後に変換を行った際の各文節の位置を文字単位で表す、32bit整数のオフセット値の配列が、bufに返される。ただし、配列の末尾に、入力された文字列長を文字数で表した値が格納される。戻り値は、配列のバイトサイズ。</summary>
 Public Const GCS_RESULTREADCLAUSE As UInteger = &H400UI
 
 ''' <summary>最後に変換を行った際の変換結果の文字列をbufに返す。戻り値は、文字列のバイトサイズ。</summary>
 Public Const GCS_RESULTSTR As UInteger = &H800UI
 
 ''' <summary>最後に変換を行った際の各文節の位置をバイト単位で表す、32bit整数のオフセット値の配列が、bufに返される。ただし、配列の末尾に、入力された文字列長をバイト数で表した値が格納される。戻り値は、配列のバイトサイズ。</summary>
 Public Const GCS_RESULTCLAUSE As UInteger = &H1000UI
 
 ''' <summary>現在の挿入位置にコンポジション文字wParamを挿入します。</summary>
 Public Const CS_INSERTCHAR As UInteger = &H2000UI
 
 ''' <summary>このメッセージを処理した結果としてキャレット位置を動かしません。</summary>
 Public Const CS_NOMOVECARET As UInteger = &H4000UI
 #End Region
 End Class
 #End Region
 
 End Class
 
 |