汉字拼音的一个解决方法(初具使用价值)

Author：水如烟
这个版本已有使用价值。如果要求不高，基本满足需要。一并贴出来，也对比一下。

这个版本的汉字库已纳入程序资源里头,大小为324K。

主要代码如下：

Namespace Businness.PinYin
Public Class SpellInformation
Private gTone As String
Private gSpellInput As String
Private gSpellExpress As String

''' <summary>
''' 声调
''' </summary>
Public Property Tone() As String
Get
Return gTone
End Get
Set(ByVal value As String)
gTone = value.Trim
End Set
End Property

''' <summary>
''' 拼音输入码
''' </summary>
Public Property SpellInput() As String
Get
Return gSpellInput
End Get
Set(ByVal value As String)
gSpellInput = value.Trim
End Set
End Property

''' <summary>
''' 拼音
''' </summary>
Public Property SpellExpress() As String
Get
Return gSpellExpress
End Get
Set(ByVal value As String)
gSpellExpress = value.Trim
End Set
End Property

Sub New()
End Sub

''' <param name="tone">声调</param>
''' <param name="spellinput">拼音输入码</param>
''' <param name="spellexpress">拼音</param>
Sub New(ByVal tone As String, ByVal spellinput As String, ByVal spellexpress As String)
Me.Tone = tone
Me.SpellInput = spellinput
Me.SpellExpress = spellexpress
End Sub

''' <param name="spellexpress">拼音</param>
Public Overrides Function Equals(ByVal spellexpress As Object) As Boolean
Return Me.SpellExpress.Equals(spellexpress)
End Function

Public Overrides Function ToString() As String
Return String.Format("拼音码 {0,-6} 声调 {1} 拼音 {2}", Me.SpellInput, Me.Tone, Me.SpellExpress)
End Function
End Class

End Namespace



Namespace Businness.PinYin
Public Class Word
Private gValue As String

''' <param name="word">单个汉字</param>
Sub New(ByVal word As String)
Me.gValue = word
End Sub

''' <summary>
''' 汉字
''' </summary>
Public ReadOnly Property Value() As String
Get
Return gValue
End Get
End Property

Public ReadOnly Property Code() As String
Get
Return Common.Code(gValue)
End Get
End Property

Private gSpellList As New Dictionary(Of String, SpellInformation)

''' <summary>
''' 拼音集
''' </summary>
Public ReadOnly Property Spells() As SpellInformation()
Get
Dim tmp(gSpellList.Count - 1) As SpellInformation
gSpellList.Values.CopyTo(tmp, 0)
Return tmp
End Get
End Property

''' <summary>
''' 是否多音字
''' </summary>
Public ReadOnly Property IsMutiSpell() As Boolean
Get
Return gSpellList.Count > 1
End Get
End Property

Public Sub AddSpell(ByVal spell As SpellInformation)
If String.IsNullOrEmpty(spell.SpellExpress) Then Exit Sub

If Me.gSpellList.ContainsKey(spell.SpellExpress) Then Exit Sub

Me.gSpellList.Add(spell.SpellExpress, spell)
End Sub

Public Sub AddSpell(ByVal tone As String, ByVal spellinput As String, ByVal spellexpress As String)
Dim tmp As New SpellInformation(tone, spellinput, spellexpress)

AddSpell(tmp)
End Sub

Public ReadOnly Property DefaultSpell() As SpellInformation
Get
If Me.gSpellList.Count = 0 Then Return Nothing
Return Me.Spells(0)
End Get
End Property

Public ReadOnly Property DefaultSpellExpress() As String
Get
If DefaultSpell Is Nothing Then Return Nothing
Return Me.DefaultSpell.SpellExpress
End Get
End Property

Public ReadOnly Property DefaultSpellInput() As String
Get
If DefaultSpell Is Nothing Then Return Nothing
Return Me.DefaultSpell.SpellInput
End Get
End Property

Public ReadOnly Property DefaultTone() As String
Get
If DefaultSpell Is Nothing Then Return Nothing
Return Me.DefaultSpell.Tone
End Get
End Property

Public ReadOnly Property AllSpellExpress() As String
Get
If Me.gSpellList.Count = 0 Then Return Nothing

If Not Me.IsMutiSpell Then Return Me.DefaultSpellExpress

Dim tmp(gSpellList.Count - 1) As String
For i As Integer = 0 To gSpellList.Count - 1
tmp(i) = Me.Spells(i).SpellExpress
Next

Return String.Join(" ", tmp)
End Get
End Property

Public ReadOnly Property AllSpellInput() As String
Get
If Me.gSpellList.Count = 0 Then Return Nothing

If Not Me.IsMutiSpell Then Return Me.DefaultSpellInput

Dim tmp(gSpellList.Count - 1) As String
For i As Integer = 0 To gSpellList.Count - 1
tmp(i) = Me.Spells(i).SpellInput
Next

Return String.Join(" ", tmp)
End Get
End Property

Public ReadOnly Property AllTone() As String
Get
If Me.gSpellList.Count = 0 Then Return Nothing

If Not Me.IsMutiSpell Then Return Me.DefaultTone

Dim tmp(gSpellList.Count - 1) As String
For i As Integer = 0 To gSpellList.Count - 1
tmp(i) = Me.Spells(i).Tone
Next

Return String.Join(" ", tmp)
End Get
End Property

Public Overrides Function ToString() As String
Dim mBuilder As New System.Text.StringBuilder
For Each spell As SpellInformation In Me.Spells
mBuilder.AppendLine(String.Concat(Me.Value, " ", spell.ToString))
Next
Return mBuilder.ToString
End Function
End Class

End Namespace



Imports System.IO
Imports System.Text.RegularExpressions

Namespace Businness.PinYin
Public Class PYService
Private gDataSet As dsPinYin

''' <summary>
''' 汉字表
''' </summary>
Public ReadOnly Property PinYinTable() As dsPinYin.PinYinDataTable
Get
Return gDataSet.PinYin
End Get
End Property

''' <summary>
''' 单个汉字信息
''' </summary>
''' <param name="word">单个汉字</param>
Public Function GetWord(ByVal word As String) As Word
Dim mRow As dsPinYin.PinYinRow = Me.gDataSet.PinYin.FindBy代码(GetCode(word))

Return RowConverter(mRow)
End Function

Private Function RowConverter(ByVal row As dsPinYin.PinYinRow) As Word
If row Is Nothing Then Return Nothing

Dim mWord As New Word(row.汉字)

Dim mSpellExpressArray() As String = row.拼音.Split(" "c)
Dim mToneArray() As String = row.声调.Split(" "c)
Dim mSpellInputArray() As String = row.拼音码.Split(" "c)

For i As Integer = 0 To mSpellExpressArray.Length - 1
mWord.AddSpell(mToneArray(i), mSpellInputArray(i), mSpellExpressArray(i))
Next

Return mWord
End Function

Private Sub RowUpdate(ByVal word As Word)
Dim mWord As Word = GetWord(word.Value)
If mWord Is Nothing Then
Dim tmpRow As dsPinYin.PinYinRow = Me.gDataSet.PinYin.AddPinYinRow(word.Value, word.Code, "", "", "", True)
mWord = RowConverter(tmpRow)
End If

For Each spell As SpellInformation In word.Spells
mWord.AddSpell(spell)
Next

Dim mRow As dsPinYin.PinYinRow = Me.gDataSet.PinYin.FindBy代码(mWord.Code)
With mRow
.拼音码 = mWord.AllSpellInput
.拼音 = mWord.AllSpellExpress
.声调 = mWord.AllTone
.单音 = Not mWord.IsMutiSpell
End With

End Sub

Public Sub Load()
UpdateFromTxt()
End Sub

'文件存放的格式是:汉字,拼音,音调,拼音码
Private Sub UpdateFromTxt()
Me.gDataSet = New dsPinYin

LzmTW.uSystem.uCollections.CommonServices.MoveNext(Of String)(My.Resources.pinyin.Split(CChar(vbCrLf)), AddressOf Action)

Me.gDataSet.AcceptChanges()
End Sub

'文件存放的格式是:汉字,拼音,音调,拼音码
Private Sub Action(ByVal line As String)

Dim mArray As String()
mArray = line.Split(","c)

If mArray.Length <> 4 Then Exit Sub

Dim mWord As String = mArray(0).Trim
Dim mSpellExpress As String = mArray(1).Trim
Dim mTone As String = mArray(2).Trim
Dim mSpellInput As String = mArray(3).Trim

Dim mWordInformation As New Word(mWord)
mWordInformation.AddSpell(mTone, mSpellInput, mSpellExpress)

RowUpdate(mWordInformation)

End Sub

''' <summary>
''' 将字符串转为拼音
''' </summary>
''' <param name="line">字符串</param>
''' <param name="isgetfirst">如是多音字,取第一个拼音</param>
''' <param name="forInput">是则查拼音码,否则查拼音</param>
Public Function ToPinyin(ByVal line As String, ByVal isgetfirst As Boolean, ByVal forInput As Boolean) As String
Dim mBuilder As New Text.StringBuilder

For Each s As Char In line.ToCharArray
If Common.IsSingleWord(s) Then
mBuilder.Append(GetPinyin(s, isgetfirst, forInput))
Else
mBuilder.Append(s)
End If
Next

Return mBuilder.ToString
End Function

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

Dim mWord As Word = GetWord(word)

If isgetfirst Or Not mWord.IsMutiSpell Then
If forInput Then
mResult = mWord.DefaultSpellInput
Else
mResult = mWord.DefaultSpellExpress
End If

Else
If forInput Then

Dim tmpList(-1) As String

For Each spell As SpellInformation In mWord.Spells
If Array.IndexOf(tmpList, spell.SpellInput) = -1 Then
LzmTW.uSystem.uCollections.CommonServices.Append(tmpList, spell.SpellInput)
End If
Next

If tmpList.Length = 1 Then
mResult = mWord.DefaultSpellInput
Else
mResult = String.Format("({0})", String.Join(" ", tmpList))
End If
Else
mResult = String.Format("({0})", mWord.AllSpellExpress)
End If

End If

Return mResult
End Function

''' <summary>
''' 按拼音查字
''' </summary>
''' <param name="pinyin">拼音</param>
Public Function WordArray(ByVal pinyin As String) As String()
Dim mRows As dsPinYin.PinYinRow() = CType(Me.gDataSet.PinYin.Select(String.Format("拼音码 LIKE '%{0}%'", pinyin)), dsPinYin.PinYinRow())
Dim mResult(-1) As String
For i As Integer = 0 To mRows.Length - 1
If Array.IndexOf(mRows(i).拼音码.Split(" "c), pinyin) <> -1 Then
LzmTW.uSystem.uCollections.CommonServices.Append(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 String.Concat(WordArray(pinyin))
End Function

Public Function GetCode(ByVal word As String) As String
Return Common.Code(word)
End Function

End Class
End Namespace

调用的代码

Public Class Form1
Dim gPinyinService As New LzmTW.Businness.PinYin.PYService

Private Sub ButtonLoad_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles ButtonLoad.Click
gPinyinService.Load()
Me.DataGridView1.DataSource = gPinyinService.PinYinTable
End Sub

Private Sub ButtonTran_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles ButtonTran.Click
Me.RichTextBox2.Text = gPinyinService.ToPinyin(Me.RichTextBox1.Text, Me.CheckBox1.Checked, Me.CheckBox2.Checked)
End Sub

Private Sub ButtonWord_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles ButtonWord.Click
Me.RichTextBox3.Text = gPinyinService.Words(Me.TextBoxPinyin.Text)
End Sub

Private Sub Button1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button1.Click
Me.RichTextBox3.Text = gPinyinService.GetWord(Me.TextBox1.Text).ToString
End Sub
End Class

效果图：















下载方案：代码