VB.NET でふりがな機能を実装する

Mar 4, 2019
POST
VB.NET

経緯

最近、周りで VB.NET を使っている人が複数人出てきた恐らく2020年にWindows7 サポート終了となるため VB6 => VB.NET へのコンバージョンの案件が増えていると思われるそのため、以前行った際に苦労したふりがな機能について備忘録として残しておくことにする

実際のコード

ふりがな取得機能の実装クラス

以下のふりがなに対応(半角および全角英数はそのまま取得)
- ひらがな
- 全角カナ
- 半角カナ

Option Strict Off
Option Explicit On

Imports System.Runtime.InteropServices
Delegate Function fncDelegate(ByVal hWnd As Integer, ByVal uMsg As Integer, ByVal wParam As Integer, ByVal lParam As Integer) As Integer

''' <summary>
''' 変換イベントクラス
''' </summary>
Public Class ConvertedEventArgs
  Inherits EventArgs

  ''' <summary>
  ''' 変換イベントクラスのコンストラクタ
  ''' </summary>
  ''' <param name="f">ふりがな文字列</param>
  ''' <param name="r">変換後文字列</param>
  Public Sub New(ByVal f As String, ByVal r As String)
    Furigana = f
    Result = r
  End Sub

  Public ReadOnly Property Furigana() As String
  Public ReadOnly Property Result() As String
End Class

''' <summary>
''' 自動ふりがな取得クラス
''' </summary>
Public Class Imecomp
  Private m_TxtSrcControl As Control
  Private m_TxtDestControl As Control
  Private WithEvents M_MsgListner As MsgListner
  Private ReadOnly m_StrConvMode As Integer

  ''' <summary>
  ''' ふりがな取得完了通知イベント
  '''
  ''' ふりがな取得が完了したことを通知する
  ''' </summary>
  ''' <param name="txtSrc">ふりがな取得対象テキストボックス</param>
  ''' <param name="txtDest">ふりがな出力対象テキストボックス</param>
  ''' <param name="e">変換イベントクラス</param>
  Public Event Converted(ByVal txtSrc As System.Object, ByVal txtDest As System.Object, ByVal e As ConvertedEventArgs)

  ''' <summary>
  ''' メッセージリスナークラス
  ''' </summary>
  Private Class MsgListner
    Inherits NativeWindow

    'Windows Message
    Public Const WM_IME_COMPOSITION As Integer = &H10F
    Public Const WM_IME_ENDCOMPOSITION As Integer = &H10E
    Public Const WM_CHAR As Integer = &H102
    Public Const WM_KEYDOWN As Integer = &H100
    Public Const WM_KEYUP As Integer = &H101

    'IME APIs
    Declare Function ImmGetCompositionString Lib "imm32.dll" Alias "ImmGetCompositionStringA" (ByVal hIMC As Integer, ByVal dw As Integer, ByRef lpv As Byte, ByVal dw2 As Integer) As Integer
    Private Const GCS_COMPREADSTR As Integer = &H1
    Private Const GCS_COMPSTR As Integer = &H8
    Private Const GCS_RESULTREADSTR As Integer = &H200
    Private Const GCS_RESULTSTR As Integer = &H800
    Declare Function ImmGetOpenStatus Lib "imm32.dll" (ByVal hIMC As Integer) As Integer
    Declare Function ImmSetOpenStatus Lib "imm32.dll" (ByVal hIMC As Integer, ByVal fOpen As Boolean) As Integer
    Declare Function ImmGetContext Lib "imm32.dll" (ByVal hWnd As Integer) As Integer
    Declare Function ImmReleaseContext Lib "imm32.dll" (ByVal hWnd As Integer, ByVal hIMC As Integer) As Integer

    'Subclass APIs
    Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hWnd As Integer, ByVal nIndex As Integer, <MarshalAs(UnmanagedType.FunctionPtr)> ByVal dwNewLong As fncDelegate) As Integer
    Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hWnd As Integer, ByVal nIndex As Integer, ByVal dwNewLong As Integer) As Integer
    Private Const GWL_WNDPROC As Integer = (-4)
    Declare Function CallWindowProc Lib "user32" Alias "CallWindowProcA" (ByVal lpPrevWndFunc As Integer, ByVal hWnd As Integer, ByVal msg As Integer, ByVal wParam As Integer, ByVal lParam As Integer) As Integer

    Private m_Enabled As Boolean = True
    Private convMode As Integer = 0
    Private pramStrConvMode As Integer = 0

    Public Event Converted(ByVal imeCompString As String, ByVal resultConvString As String)

    Public Property Enabled() As Boolean
      Get
        Return m_Enabled
      End Get

      Set(ByVal Value As Boolean)
        m_Enabled = Value
      End Set
    End Property

    ''' <summary>
    ''' ふりがな取得対象コントロールのウィンドウプロシージャ
    ''' </summary>
    ''' <param name="m">Windows メッセージ</param>
    Protected Overrides Sub WndProc(ByRef m As System.Windows.Forms.Message)
      Dim hIMC As Integer
      Dim intLength As Integer

      If m_Enabled Then
        Select Case m.Msg
          Case WM_IME_COMPOSITION
            Dim bytBuff() As Byte
            Dim strResult As String = ""
            Dim strFurigana As String = ""

            hIMC = ImmGetContext(Me.Handle.ToInt32)

            '変換後文字列の取得
            intLength = ImmGetCompositionString(hIMC, GCS_RESULTSTR, 0, 0)
            If intLength > 0 Then
              ReDim bytBuff(intLength - 1)
              ImmGetCompositionString(hIMC, GCS_RESULTSTR, bytBuff(0), intLength)
              strResult = System.Text.Encoding.Default.GetString(bytBuff)
            End If

            'ふりがな文字列
            intLength = ImmGetCompositionString(hIMC, GCS_RESULTREADSTR, 0, 0)
            If intLength > 0 Then
              ReDim bytBuff(intLength - 1)
              ImmGetCompositionString(hIMC, GCS_RESULTREADSTR, bytBuff(0), intLength)
              strFurigana = System.Text.Encoding.Default.GetString(bytBuff)
              convMode = IIf(pramStrConvMode = 0, vbNarrow, pramStrConvMode)

              '追加する文字種の判断
              If ChrIsNarrow(StrConv(strResult, VbStrConv.Narrow)) Then
                strFurigana = strResult
              End If

              'テキストを追加
              Select Case convMode
                Case VbStrConv.Narrow
                  strFurigana = StrConv(strFurigana, VbStrConv.Narrow)
                Case VbStrConv.Katakana
                  strFurigana = StrConv(strFurigana, VbStrConv.Wide)
                Case Else
                  strFurigana = StrConv(StrConv(strFurigana, VbStrConv.Wide), convMode)
              End Select

              'イベント起動
              RaiseEvent Converted(strFurigana, strResult)
            End If

            ImmReleaseContext(Me.Handle.ToInt32, hIMC)
          Case WM_CHAR  '半角英数字
            hIMC = ImmGetContext(Me.Handle.ToInt32)
            If ImmGetOpenStatus(hIMC) = 0 Then
              If m.WParam.ToInt32 >= 32 Then
                'イベント起動
                RaiseEvent Converted(Chr(m.WParam.ToInt32), Chr(m.WParam.ToInt32))
              End If
            End If

            ImmReleaseContext(Me.Handle.ToInt32, hIMC)
        End Select
      End If

      MyBase.WndProc(m)
    End Sub

    ''' <summary>
    ''' メッセージリスナークラスのコンストラクタ
    ''' </summary>
    ''' <param name="target">入力文字</param>
    ''' <param name="strConvMode">文字変換モード</param>
    Public Sub New(ByVal target As IntPtr, ByRef strConvMode As Integer)
      pramStrConvMode = strConvMode
      AssignHandle(target)
    End Sub

    Protected Overrides Sub Finalize()
      ReleaseHandle()
      MyBase.Finalize()
    End Sub

    ''' <summary>
    ''' 半角文字かどうかを判定して返す
    ''' </summary>
    ''' <param name="target">ふりがな取得対象テキストボックス</param>
    ''' <returns>true:半角文字/false:半角文字以外</returns>
    Public Function ChrIsNarrow(ByRef target As String) As Boolean

      Dim nPt As Integer
      Dim NowPt As Integer
      Dim NowCode As Integer
      Dim fNarrow As Boolean

      fNarrow = True
      nPt = Len(target)
      For NowPt = 1 To nPt
        NowCode = Asc(Mid(target, NowPt, 1))
        If NowCode < 0 Or NowCode > 255 Then
          fNarrow = False
          Exit For
        End If
      Next NowPt

      ChrIsNarrow = fNarrow
    End Function
  End Class

  ''' <summary>
  ''' 自動ふりがな取得クラスのコンストラクタ
  ''' </summary>
  ''' <param name="txtSrc">ふりがな取得対象テキストボックス</param>
  ''' <param name="txtDest">ふりがな出力対象テキストボックス</param>
  ''' <param name="strConvMode">ふりがなの種類</param>
  Public Sub New(ByVal txtSrc As Control, txtDest As Control, strConvMode As Integer)
    M_MsgListner = New MsgListner(txtSrc.Handle, strConvMode)
    m_TxtSrcControl = txtSrc
    m_TxtDestControl = txtDest
  End Sub

  Public ReadOnly Property TxtSrcControl() As Control
    Get
      Return m_TxtSrcControl
    End Get
  End Property

  Public ReadOnly Property TxtDestControl() As Control
    Get
      Return m_TxtDestControl
    End Get
  End Property

  Public Property Enabled() As Boolean
    Get
      Return M_MsgListner.Enabled
    End Get

    Set(ByVal Value As Boolean)
      M_MsgListner.Enabled = Value
    End Set
  End Property

  Private Sub M_MsgListner_Converted(ByVal imeCompString As String, ByVal resultConvString As String) Handles M_MsgListner.Converted
    RaiseEvent Converted(Me.TxtSrcControl, Me.TxtDestControl, New ConvertedEventArgs(imeCompString, resultConvString))
  End Sub
End Class

ふりがな取得機能テスト用フォーム

初期処理時にふりがな種別を指定する

Imports Microsoft.VisualBasic

Public Class Form1
  Private WithEvents ImeComp As Imecomp 'ふりがな取得イベント

  Private Sub Frm1_Load(ByVal eventSender As System.Object, ByVal eventArgs As System.EventArgs) Handles MyBase.Load
    ImeComp = New Imecomp(Me.TextBox1, Me.TextBox2, VbStrConv.Hiragana) 'ふりがなの種類（ひらがな）
    'imeComp = New Imecomp(Me.TextBox1, Me.TextBox3, VbStrConv.Katakana) 'ふりがなの種類（全角カナ）
    'ImeComp = New Imecomp(Me.TextBox1, Me.TextBox4, VbStrConv.Narrow) 'ふりがなの種類（半角カナ）
  End Sub

  Private Sub ImeComp_Converted(ByVal txtSrc As Object, ByVal txtDest As Object, ByVal e As ConvertedEventArgs) Handles ImeComp.Converted
    txtDest.Text &= e.Furigana
    If Len(txtDest.Text) > txtDest.MaxLength Then
      txtDest.Text = Strings.Left(txtDest.Text, txtDest.MaxLength)
    End If
  End Sub

  Private Sub TextBox1_TextChanged(sender As Object, e As EventArgs) Handles TextBox1.TextChanged
    If TextBox1.Text = "" Then
      TextBox2.Text = ""
      TextBox3.Text = ""
      TextBox4.Text = ""
    End If
  End Sub
End Class

実行結果イメージ

Feb 28, 2019
POST

Mar 6, 2019
POST

comments powered by Disqus