tagCANDY CGI VBレスキュー(花ちゃん) - VBレスキュー(花ちゃん)の投稿サンプル用掲示板 - Visual Basic 6.0 VB2005 VB2010
VB2005用トップページへVBレスキュー(花ちゃん)のトップページVB6.0用のトップページ
VBレスキュー(花ちゃん)の投稿サンプル用掲示板
     サンプル投稿用掲示板  VB2005 〜 用トップページ  VB6.0 用 トップページ
読み仮名取得テキストボックス ( No.0 )  [親スレッドへ]
日時: 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



 [スレッド一覧へ] [親スレッドへ]