完美的汉字转拼音函数

liwen

这是使用API函数获取汉字拼音的代码，不过按程序设定，系统中必须安装有“微软拼音输入法”，但程序执行时好象并不涉及“微软拼音输入法”，有谁系统中没装“微软拼音输入法”的测试一下将“微软拼音输入法”改为其他拼音输入法试试不知是否能通过，程序可以获得汉字和词组的拼音（词组中的多音字可以区别），且能获得拼音的声调，同时对于繁体字好象也能得到正确的结果。



[ 本帖最后由 liwen 于 2007-8-3 16:14 编辑 ]

sgrshh29

谢谢分享,另外能不能做成这样的?

jicheng

２楼的是不是有这个呀

[ 本帖最后由 jicheng 于 2007-8-3 16:49 编辑 ]

liwen

2楼的好东西，怎么以前就见不到呢？

据我据计，2楼的要求应该通过改写一定的代码来判断或许可以实现。
顺便问一下，带声调的注音符号字符表中有吗？

sgrshh29

原帖由 liwen 于 2007-8-3 16:57 发表
2楼的好东西，怎么以前就见不到呢？

据我据计，2楼的要求应该通过改写一定的代码来判断或许可以实现。
顺便问一下，带声调的注音符号字符表中有吗？

ā, á, ǎ, à, ē, é, ě, è, ī, í, ǐ, ì, ō, ó, ǒ, ò, ū, ú, ǔ, ù, ǖ, ǘ, ǚ, ǜ, ü,

liwen

加上以下代码好似可以达到2楼的第一个要求，  代码只做了简单测试，可能也会有不符合汉语拼音规则的地方，代码做的也比较烂，还是希望sgrshh29 能奉献一个2楼那个源码。

Public Function ZH(str As String)
Dim aa() As String
Dim a As String
Dim o As String
Dim e As String
Dim i As String
Dim u As String
Dim v As String
Dim k, kk As Integer
Dim T, j As Integer

a = "āáǎà"
o = "ōóǒò"
e = "ēéěè"
i = "īíǐì"
u = "ūúǔù"
v = "ǖǘǚǜ"
aa() = Split(PinyinConvers(str), " ")
For T = 0 To UBound(aa())
zhstr = aa(T)
k = 0
kk = 0
For j = 1 To Len(zhstr)
If InStr("aoeiuv", Mid(zhstr, j, 1)) > 0 Then
k = k + 1
If k > 1 Then
If Mid(zhstr, kk, 1) = "u" Then
ntstr = Left(zhstr, j - 1) & IIf(Mid(zhstr, j, 1) = "a", Mid(a, Right(zhstr, 1), 1), IIf(Mid(zhstr, j, 1) = "o", Mid(o, Right(zhstr, 1), 1), IIf(Mid(zhstr, j, 1) = "e", Mid(e, Right(zhstr, 1), 1), IIf(Mid(zhstr, j, 1) = "e", Mid(e, Right(zhstr, 1), 1), IIf(Mid(zhstr, j, 1) = "i", Mid(i, Right(zhstr, 1), 1), IIf(Mid(zhstr, j, 1) = "u", Mid(u, Right(zhstr, 1), 1), Mid(v, Right(zhstr, 1), 1))))))) & Mid(zhstr, j + 1, Len(zhstr) - j - 1)
End If
Else
ntstr = Left(zhstr, j - 1) & IIf(Mid(zhstr, j, 1) = "a", Mid(a, Right(zhstr, 1), 1), IIf(Mid(zhstr, j, 1) = "o", Mid(o, Right(zhstr, 1), 1), IIf(Mid(zhstr, j, 1) = "e", Mid(e, Right(zhstr, 1), 1), IIf(Mid(zhstr, j, 1) = "e", Mid(e, Right(zhstr, 1), 1), IIf(Mid(zhstr, j, 1) = "i", Mid(i, Right(zhstr, 1), 1), IIf(Mid(zhstr, j, 1) = "u", Mid(u, Right(zhstr, 1), 1), Mid(v, Right(zhstr, 1), 1))))))) & Mid(zhstr, j + 1, Len(zhstr) - j - 1)
kk = j
End If
End If
Next j
If zhstr <> "" Then nstr = nstr & " " & ntstr

Next
ZH = nstr

End Function

liwen

稍微减少一点代码：
Public Function ZHB(str As String)
Dim aa() As String
Dim a As String
Dim k, kk As Integer
Dim T, j As Integer

a = "āáǎàōóǒòēéěèīíǐìūúǔùǖǘǚǜ"
aa() = Split(PinyinConvers(str), " ")
For T = 0 To UBound(aa())
zhstr = aa(T)
k = 0
kk = 0
For j = 1 To Len(zhstr)
If InStr("aoeiuv", Mid(zhstr, j, 1)) > 0 Then
k = k + 1
If k > 1 Then
If Mid(zhstr, kk, 1) = "u" Then
ntstr = Left(zhstr, j - 1) & Mid(a, (InStr("aoeiuv", Mid(zhstr, j, 1)) - 1) * 4 + Right(zhstr, 1), 1) & Mid(zhstr, j + 1, Len(zhstr) - j - 1)
End If
Else
ntstr = Left(zhstr, j - 1) & Mid(a, (InStr("aoeiuv", Mid(zhstr, j, 1)) - 1) * 4 + Right(zhstr, 1), 1) & Mid(zhstr, j + 1, Len(zhstr) - j - 1)
kk = j
End If
End If
Next j
If zhstr <> "" Then nstr = nstr & " " & ntstr

Next
ZHB = nstr

End Function

sgrshh29

原帖由 liwen 于 2007-8-4 13:45 发表
稍微减少一点代码：
Public Function ZHB(str As String)
Dim aa() As String
Dim a As String
Dim k, kk As Integer
Dim T, j As Integer

a = "āáǎàōóǒòēéěèīíǐìūúǔùǖǘǚǜ"
a ...

好贴,顶一把.非常抱歉,因为源代码(其实这个源代码也有一部分是借鉴了其它的代码)已经找不到了,只有一个用源代码转换过来的dll文件.打开数据库后,如果有引用错误,只要在vba的工具引用中重新引用一下这个dll(有时要多引用几次才引用成功).还请liwen见谅.下面就是这个比较完善的汉字转拼音的示例,只记得代码不是很多,大概是你的代码的一半不到一点.

goto2008

嘿嘿，学习下。。。。。。。。。

ok003

真不错。
另外问一下：源代码转为dll 怎么转呢？