漢字拼音的一個完整解決方法！[2]

＜summary＞
將字符串轉為拼音
＜/summary＞
＜param name=line＞字符串＜/param＞
＜param name=isgetfirst＞如是多音字取第一個拼音＜/param＞
Public Function ToPinyin(ByVal line As String ByVal isgetfirst As Boolean) As String
Dim mBuilder As New TextStringBuilder

For Each s As Char In lineToCharArray
If IsTrue(s) Then
mBuilderAppend(GetPinyin(s isgetfirst))
Else
mBuilderAppend(s)
End If
Next

Return mBuilderToString
End Function

Private Function GetPinyin(ByVal word As String ByVal isgetfirst As Boolean) As String
Dim mResult As String = word

Dim mArray As String() = PinYinArray(ChineseCode(word)) 取拼音組
If Not mArray Is Nothing Then
If mArrayLength = Or isgetfirst Then
mResult = mArray() 單音的
Else

mResult = StringFormat(({}) StringJoin( mArray)) 多音的用括號括住拼音間用逗號隔開
End If
End If

Return mResult
End Function

取拼音組
Private Function PinYinArray(ByVal code As String) As String()
Dim mRow As dsPinYinPinYinRow = MegDataSetPinYinFindBy代碼(code)
If mRow Is Nothing Then Return Nothing
Return mRow拼音Split( c)
End Function

＜summary＞
按拼音查字
＜/summary＞
＜param name=pinyin＞拼音＜/param＞
Public Function WordArray(ByVal pinyin As String) As String()
Dim mRows As dsPinYinPinYinRow() = CType(MegDataSetPinYinSelect(StringFormat(拼音 LIKE %{}% pinyin)) dsPinYinPinYinRow())
Dim mResult() As String
For i As Integer = To mRowsLength
If ArrayIndexOf(mRows(i)拼音Split( c) pinyin) ＜＞ Then
MeAppend(mResult mRows(i)漢字)
End If
Next
Return mResult
End Function

＜summary＞
按拼音查字
＜/summary＞
＜param name=pinyin＞拼音＜/param＞
Public Function Words(ByVal pinyin As String) As String
Return StringConcat(WordArray(pinyin))
End Function

＜summary＞
漢字代碼
＜/summary＞
＜param name=word＞單個漢字＜/param＞
Public Shared Function ChineseCode(ByVal word As String) As String
If Not IsTrue(word) Then Return Nothing

Dim bytes() As Byte = SystemTextEncodingDefaultGetBytes(word)

Return StringConcat(Hex(bytes()) Hex(bytes()))
End Function

＜summary＞
是否是單個漢字
＜/summary＞
＜param name=word＞字符＜/param＞
Public Shared Function IsTrue(ByVal word As String) As Boolean
If word Is Nothing Then Return False

Return SystemTextRegularExpressionsRegexIsMatch(word ^[\ue\ufa]$)
End Function

Private Sub Append(ByRef collection As String() ByVal value As String)
ReDim Preserve collection(collectionLength)
collection(collectionLength ) = value
End Sub
End Class
End Namespace

[]  []  

From:http://tw.wingwit.com/Article/program/net/201311/15436.html