这个版本已有使用价值。如果要求不高，基本满足需要。一并贴出来，也对比一下。
这个版本的汉字库已纳入程序资源里头,大小为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
效果图：
下载方案：代码
查看本文来源
京公网安备 11010802021500号