2010年7月23日金曜日

.NET 振り仮名を取得する

入力した文字列より振り仮名を取得するカスタムテキストボックスのサンプルです。
カスタムテキストボックスは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

2010年7月22日木曜日

.NET 50音検索

50音検索って結構面倒ですね・・・

データテーブルに半角カナで保存されているフィールドを50音検索するサンプルです。

SQLのWhere句に Tool.KanaSearchFilterStringメソッドの戻り値を付ければ
データテーブル以外にもデータベースに対しても50音検索できます。

Public Class Form1


    Private _tbl As DataTable

    Public Sub New()

        ' この呼び出しは、Windows フォーム デザイナで必要です。
        InitializeComponent()

        ' InitializeComponent() 呼び出しの後で初期化を追加します。

        'テストデータ作成
        Call CreateTestData()
    End Sub

    'テストデータ作成
    Private Sub CreateTestData()

        Dim tbl As New DataTable
        tbl.Columns.Add("Kana", GetType(String))
        tbl.Rows.Add(New Object() {"ア"})
        tbl.Rows.Add(New Object() {"カ"})
        tbl.Rows.Add(New Object() {"サ"})
        tbl.Rows.Add(New Object() {"タ"})
        tbl.Rows.Add(New Object() {"ナ"})
        tbl.Rows.Add(New Object() {"ハ"})
        tbl.Rows.Add(New Object() {"マ"})
        tbl.Rows.Add(New Object() {"ヤ"})
        tbl.Rows.Add(New Object() {"ラ"})
        tbl.Rows.Add(New Object() {"ワ"})

        Me._tbl = tbl
    End Sub

    Private Sub rdoKana_CheckedChanged(ByVal sender As System.Object, ByVal e As System.EventArgs) _
    Handles rdoKana_All.CheckedChanged _
            , rdoKana_A.CheckedChanged _
            , rdoKana_Ka.CheckedChanged _
            , rdoKana_Sa.CheckedChanged _
            , rdoKana_Ta.CheckedChanged _
            , rdoKana_Na.CheckedChanged _
            , rdoKana_Ha.CheckedChanged _
            , rdoKana_Ma.CheckedChanged _
            , rdoKana_Ya.CheckedChanged _
            , rdoKana_Ra.CheckedChanged _
            , rdoKana_Wa.CheckedChanged _
            , rdoKana_Other.CheckedChanged

        If DirectCast(sender, RadioButton).Checked = False Then
            Return
        End If

        Dim kana As Tool.KanaSearchType
        If rdoKana_A.Checked Then
            kana = Tool.KanaSearchType.A
        ElseIf rdoKana_Ka.Checked Then
            kana = Tool.KanaSearchType.Ka
        ElseIf rdoKana_Sa.Checked Then
            kana = Tool.KanaSearchType.Sa
        ElseIf rdoKana_Ta.Checked Then
            kana = Tool.KanaSearchType.Ta
        ElseIf rdoKana_Na.Checked Then
            kana = Tool.KanaSearchType.Na
        ElseIf rdoKana_Ha.Checked Then
            kana = Tool.KanaSearchType.Ha
        ElseIf rdoKana_Ma.Checked Then
            kana = Tool.KanaSearchType.Ma
        ElseIf rdoKana_Ya.Checked Then
            kana = Tool.KanaSearchType.Ya
        ElseIf rdoKana_Ra.Checked Then
            kana = Tool.KanaSearchType.Ra
        ElseIf rdoKana_Wa.Checked Then
            kana = Tool.KanaSearchType.Wa
        ElseIf rdoKana_Other.Checked Then
            kana = Tool.KanaSearchType.Other
        End If

        Dim sFilter As String = String.Empty
        sFilter = Tool.KanaSearchFilterString("Kana", kana, Tool.KanaSearchDataType.DataTable)
        Dim row() As DataRow = Me._tbl.Select(sFilter)

        Console.WriteLine("【{0}】", kana.ToString)
        For Each r As DataRow In row
            Console.WriteLine(r.Item(0))
        Next
    End Sub

End Class

Public Class Tool

    ''' <summary>
    ''' 50音検索の検索文字
    ''' </summary>
    ''' <remarks></remarks>
    Public Enum KanaSearchType
        A = 1
        Ka = 2
        Sa = 3
        Ta = 4
        Na = 5
        Ha = 6
        Ma = 7
        Ya = 8
        Ra = 9
        Wa = 10
        Other = 11
    End Enum

    ''' <summary>
    ''' 50音検索するデータ種
    ''' </summary>
    ''' <remarks></remarks>
    Public Enum KanaSearchDataType
        Oracle = 1
        SQLServer = 2
        Access = 3
        DataTable = 4
    End Enum

    ''' <summary>
    ''' 50音検索を行うフィルター文字列を作成します。
    ''' </summary>
    ''' <param name="sFieldNm">50音検索を行うフィールド名</param>
    ''' <param name="kana">検索するカナ</param>
    ''' <param name="dataType">検索するデータ種</param>
    ''' <returns></returns>
    ''' <remarks>
    ''' </remarks>
    Public Shared Function KanaSearchFilterString(ByVal sFieldNm As String, ByVal kana As KanaSearchType, ByVal dataType As KanaSearchDataType) As String

        'Oracle SubStr
        'DataTable SubString
        'SQLServer SubString
        'Access Mid
        Dim funcNm As String
        Select Case dataType
            Case KanaSearchDataType.Oracle
                funcNm = "Substr"
            Case KanaSearchDataType.Access
                funcNm = "Mid"
            Case Else
                funcNm = "SubString"
        End Select


        Dim sFilter As String = String.Empty
        If kana = KanaSearchType.A Then
            sFilter = "{0}({1},1,1) in ('ア','イ','ウ','エ','オ','ァ','ィ','ゥ','ェ','ォ')"
        ElseIf kana = KanaSearchType.Ka Then
            sFilter = "{0}({1},1,1) in ('カ','キ','ク','ケ','コ')"
        ElseIf kana = KanaSearchType.Sa Then
            sFilter = "{0}({1},1,1) in ('サ','シ','ス','セ','ソ')"
        ElseIf kana = KanaSearchType.Ta Then
            sFilter = "{0}({1},1,1) in ('タ','チ','ツ','テ','ト')"
        ElseIf kana = KanaSearchType.Na Then
            sFilter = "{0}({1},1,1) in ('ナ','ニ','ヌ','ネ','ノ')"
        ElseIf kana = KanaSearchType.Ha Then
            sFilter = "{0}({1},1,1) in ('ハ','ヒ','フ','ヘ','ホ')"
        ElseIf kana = KanaSearchType.Ma Then
            sFilter = "{0}({1},1,1) in ('マ','ミ','ム','メ','モ')"
        ElseIf kana = KanaSearchType.Ya Then
            sFilter = "{0}({1},1,1) in ('ヤ','ユ','ヨ','ャ','ュ','ョ')"
        ElseIf kana = KanaSearchType.Ra Then
            sFilter = "{0}({1},1,1) in ('ラ','リ','ル','レ','ロ')"
        ElseIf kana = KanaSearchType.Wa Then
            sFilter = "{0}({1},1,1) in ('ワ','ヲ','ン')"
        ElseIf kana = KanaSearchType.Other Then
            sFilter = "{1} IS NULL OR {0}({1},1,1) not in ('ア','イ','ウ','エ','オ','ァ','ィ','ゥ','ェ','ォ'" & _
                                                        ",'カ','キ','ク','ケ','コ'" & _
                                                        ",'サ','シ','ス','セ','ソ'" & _
                                                        ",'タ','チ','ツ','テ','ト'" & _
                                                        ",'ナ','ニ','ヌ','ネ','ノ'" & _
                                                        ",'ハ','ヒ','フ','ヘ','ホ'" & _
                                                        ",'マ','ミ','ム','メ','モ'" & _
                                                        ",'ヤ','ユ','ヨ','ャ','ュ','ョ'" & _
                                                        ",'ラ','リ','ル','レ','ロ'" & _
                                                        ",'ワ','ヲ','ン')"
        End If


        If Not String.IsNullOrEmpty(sFilter) Then
            sFilter = String.Format(sFilter, funcNm, sFieldNm)
        End If
        Return sFilter
    End Function
End Class