|
|
以下代码能查二级汉字库
Option Explicit
Private sFilter As String
Private Type TypePos
Min As Long '一个声母字符左区间
Max As Long '一个声母字符右区间
cFirst As String '保存声母字符
End Type
Public tyChinaPos(26) As TypePos '区位表
Public sSecondPos As String ' 第二区位表
' 给定一个字符串返回这个字符串的拼音助记字符串
Public Function GetPinYin(strS As String) As String
Dim I As Integer
Dim strRet As String
If sSecondPos = "" Then ZhuJiInit
strRet = "" '设置返回的字符串为空
For I = 1 To Len(strS)
If CharFilter(Mid(strS, I, 1)) = False Then '则说明过滤掉了
'如果没有过滤掉,则返回其小写字母
strRet = strRet + LCase(Mid(strS, I, 1))
ElseIf Asc(Mid(strS, I, 1)) < 0 Then '说明是汉字，则求其第一个字母
strRet = strRet + GetChinaChar(Mid(strS, I, 1)) '则将前面的拼音助记与返回的拼音合并
' 如果为0到9之间的数字,则不改变原来的数字
ElseIf Mid(strS, I, 1) >= "0" And Mid(strS, I, 1) <= "9" Then '否则不是汉字则返回小写字母
strRet = strRet + LCase(Mid(strS, I, 1))
' 如果为A到Z之间的字母,则转换为小写字母
ElseIf Mid(strS, I, 1) >= "A" And Mid(strS, I, 1) <= "Z" Then
strRet = strRet + LCase(Mid(strS, I, 1))
' 如果为a到z之间的字母,则不改变原来的字母
ElseIf Mid(strS, I, 1) >= "a" And Mid(strS, I, 1) <= "z" Then
strRet = strRet + LCase(Mid(strS, I, 1))
' 其他则为非法字符,将被过滤掉
End If
Next I
GetPinYin = strRet '将求得的拼音助记码返回
End Function
Private Sub ZhuJiInit()
Dim I As Integer '总共23个声
sSecondPos = "CJWGNSPGCGNE[Y[BTYYZDXYKYGT[JNMJQMBSGZSCYJSYY[PGKBZGY[YWJKGKLJYWKPJQHY[W[DZLSGMRYPYWWCCKZNKYYGTTNJJNYKKZYTCJNMCYLQLYPYQFQRPZSLWBTGKJFYXJWZLTBNCXJJJJTXDTTSQZYCDXXHGCK[PHFFSS[YBGXLPPBYLL[HLXS[ZM[JHSOJNG" & _
"HDZQYKLGJHSGQZHXQGKEZZWYSCSCJXYEYXADZPMDSSMZJZQJYZC[J[WQJBYZPXGZNZCPWHKXHQKMWFBPBYDTJZZKQHYLYGXFPTYJYYZPSZLFCHMQSHGMXXSXJ[[DCSBBQBEFSJYHXWGZKPYLQBGLDLCCTNMAYDDKSSNGYCSGXLYZAYBNPTSDKDYLHGYMYLCXPY[JNDQJ" & _
"WXQXFYYFJLEJPZRXCCQWQQSBNKYMGPLBMJRQCFLNYMYQMSQYRBCJTHZTQFRXQHXMJJCJLXQGJMSHZKBSWYEMYLTXFSYDSWLYCJQXSJNQBSCTYHBFTDCYZDJWYGHQFRXWCKQKXEBPTLPXJZSRMEBWHJLBJSLYYSMDXLCLQKXLHXJRZJMFQHXHWYWSBHTRXXGLHQHFNM[Y" & _
"KLDYXZPYLGG[MTCFPAJJZYLJTYANJGBJPLQGDZYQYAXBKYSECJSZNSLYZHSXLZCGHPXZHZNYTDSBCJKDLZAYFMYDLEBBGQYZKXGLDNDNYSKJSHDLYXBCGHXYPKDJMMZNGMMCLGWZSZXZJFZNMLZZTHCSYDBDLLSCDDNLKJYKJSYCJLKWHQASDKNHCSGANHDAASHTCPLC" & _
"PQYBSDMPJLPZJOQLCDHJJYSPRCHN[NNLHLYYQYHWZPTCZGWWMZFFJQQQQYXACLBHKDJXDGMMYDJXZLLSYGXGKJRYWZWYCLZMSSJZLDBYD[FCXYHLXCHYZJQ[[QAGMNYXPFRKSSBJLYXYSYGLNSCMHZWWMNZJJLXXHCHSY[[TTXRYCYXBYHCSMXJSZNPWGPXXTAYBGAJC" & _
"XLY[DCCWZOCWKCCSBNHCPDYZNFCYYTYCKXKYBSQKKYTQQXFCWCHCYKELZQBSQYJQCCLMTHSYWHMKTLKJLYCXWHEQQHTQH[PQ[QSCFYMNDMGBWHWLGSLLYSDLMLXPTHMJHWLJZYHZJXHTXJLHXRSWLWZJCBXMHZQXSDZPMGFCSGLSXYMJSHXPJXWMYQKSMYPLRTHBXFTP" & _
"MHYXLCHLHLZYLXGSSSSTCLSLDCLRPBHZHXYYFHB[GDMYCNQQWLQHJJ[YWJZYEJJDHPBLQXTQKWHLCHQXAGTLXLJXMSL[HTZKZJECXJCJNMFBY[SFYWYBJZGNYSDZSQYRSLJPCLPWXSDWEJBJCBCNAYTWGMPAPCLYQPCLZXSBNMSGGFNZJJBZSFZYNDXHPLQKZCZWALSB" & _
"CCJX[YZGWKYPSGXFZFCDKHJGXDLQFSGDSLQWZKXTMHSBGZMJZRGLYJBPMLMSXLZJQQHZYJCZYDJWBMYKLDDPMJEGXYHYLXHLQYQHKYCWCJMYYXNATJHYCCXZPCQLBZWWYTWBQCMLPMYRJCCCXFPZNZZLJPLXXYZTZLGDLDCKLYRZZGQTGJHHGJLJAXFGFJZSLCFDQZLC" & _
"LGJDJCSNZLLJPJQDCCLCJXMYZFTSXGCGSBRZXJQQCTZHGYQTJQQLZXJYLYLBCYAMCSTYLPDJBYREGKLZYZHLYSZQLZNWCZCLLWJQJJJKDGJZOLBBZPPGLGHTGZXYGHZMYCNQSYCYHBHGXKAMTXYXNBSKYZZGJZLQJDFCJXDYGJQJJPMGWGJJJPKQSBGBMMCJSSCLPQPD" & _
"XCDYYKY[CJDDYYGYWRHJRTGZNYQLDKLJSZZGZQZJGDYKSHPZMTLCPWNJAFYZDJCNMWESCYGLBTZCGMSSLLYXQSXSBSJSBBSGGHFJLYPMZJNLYYWDQSHZXTYYWHMZYHYWDBXBTLMSYYYFSXJC[DXXLHJHF[SXZQHFZMZCZTQCXZXRTTDJHNNYZQQMNQDMMG[YDXMJGDHC" & _
"DYZBFFALLZTDLTFXMXQZDNGWQDBDCZJDXBZGSQQDDJCMBKZFFXMKDMDSYYSZCMLJDSYNSBRSKMKMPCKLGDBQTFZSWTFGGLYPLLJZHGJ[GYPZLTCSMCNBTJBQFKTHBYZGKPBBYMTDSSXTBNPDKLEYCJNYDDYKZDDHQHSDZSCTARLLTKZLGECLLKJLQJAQNBDKKGHPJTZQ" & _
"KSECSHALQFMMGJNLYJBBTMLYZXDCJPLDLPCQDHZYCBZSCZBZMSLJFLKRZJSNFRGJHXPDHYJYBZGDLQCSEZGXLBLGYXTWMABCHECMWYJYZLLJJYHLG[DJLSLYGKDZPZXJYYZLWCXSZFGWYYDLYHCLJSCMBJHBLYZLYCBLYDPDQYSXQZBYTDKYXJY[CNRJMPDJGKLCLJBC" & _
"TBJDDBBLBLCZQRPPXJCJLZCSHLTOLJNMDDDLNGKAQHQHJGYKHEZNMSHRP[QQJCHGMFPRXHJGDYCHGHLYRZQLCYQJNZSQTKQJYMSZSWLCFQQQXYFGGYPTQWLMCRNFKKFSYYLQBMQAMMMYXCTPSHCPTXXZZSMPHPSHMCLMLDQFYQXSZYJDYJZZHQPDSZGLSTJBCKBXYQZJ" & _
"SGPSXQZQZRQTBDKYXZKHHGFLBCSMDLDGDZDBLZYYCXNNCSYBZBFGLZZXSWMSCCMQNJQSBDQSJTXXMBLTXZCLZSHZCXRQJGJYLXZFJPHYMZQQYDFQJJLZZNZJCDGZYGCTXMZYSCTLKPHTXHTLBJXJLXSCDQXCBBTJFQZFSLTJBTKQBXXJJLJCHCZDBZJDCZJDCPRNPQCJ" & _
"PFCZLCLZXZDMXMPHJSGZGSZZQLYLWTJPFSYASMCJBTZKYCWMYTCSJJLJCQLWZMALBXYFBPNLSFHTGJWEJJXXGLLJSTGSHJQLZFKCGNNNSZFDEQFHBSAQTGYLBXMMYGSZLDYDQMJJRGBJTKGDHGKBLQKBDMBYLXWCXYTTYBKMRTJZXQJBHLMHMJJZMQASLDCYXYQDLQCAFYWYXQHZ"
Dim F As String, W As Integer
F = "aB0A1bB0C5cB2C1dB4EEeB6EAfB7A2gB8C1hB9FEjBBF7kBFA6lC0ACmC2E8nC4C3oC5B6pC5BEqC6DArC8BBsC8F6tCBFAwCDDAxCEF4yD1B9zD4D1"
I = 0
While I * 5 + 1 < Len(F)
W = Asc(Mid(F, I * 5 + 1, 1)) - 97
tyChinaPos(W).cFirst = Mid(F, I * 5 + 1, 1)
tyChinaPos(W).Min = Val("&h" & Mid(F, I * 5 + 2, 4))
If W < 25 Then
tyChinaPos(W).Max = Val("&h" & Mid(F, I * 5 + 2 + 5, 4)) - 1
Else
tyChinaPos(W).Max = -10247
End If
I = I + 1
Wend
End Sub
' 把字符串过滤，如果包含要过滤的字符串则过滤掉
Private Function CharFilter(strS As String) As Boolean
Dim I As Integer
Dim bRet As Boolean
bRet = True
' 如果用户没有设置过滤字符串，则返回真，
' 如果设置了则按用户设置的过滤字符串，则过滤strS字符串中的字符
If sFilter = "" And Trim(sFilter) = "" Then
bRet = True
Else
For I = 1 To Len(sFilter)
If Mid(sFilter, I, 1) = strS Then
bRet = False
Exit For
End If
Next I
End If
CharFilter = bRet
End Function
' 得到一个汉字的第一个字母,并且返回
Private Function GetChinaChar(strSt As String) As String
Dim I As Integer
Dim iPos As Long
Dim strRetF As String
strRetF = ""
' 如果是一级汉字,遍历其值所在的区间
If Asc(strSt) >= -20319 And Asc(strSt) <= -10247 Then
For I = 0 To 25 '查找区位表中有符合条件的,如果有则返回相应的声母
If Asc(strSt) >= tyChinaPos(I).Min And Asc(strSt) <= tyChinaPos(I).Max Then
strRetF = tyChinaPos(I).cFirst
Exit For
End If
Next I
' 如果是二级汉字,则算其所在的区并求出偏移量,从而求出其声母
ElseIf Asc(strSt) >= -10079 And Asc(strSt) < -2050 Then
iPos = Asc(strSt) + 10080 - ((Asc(strSt) + 10079) \ 256) * 162
strRetF = LCase(Mid(sSecondPos, iPos, 1))
End If
GetChinaChar = strRetF '将声母返回
End Function |
|
楼主: jack.zhou
沪公网安备 31011702000001号 沪ICP备11019229号-2
发表于 2009-4-23 09:34
