如何获得汉字的拼音首字？

Function GET_hzPY(strCHI As String)
'strCHI 为一个汉字
Dim lcretn As String
cArea = Asc(strCHI)
cArea = cArea + 65536
Select Case cArea
   Case 45217 To 45252
        lcretn = "A"
   Case 45253 To 45760
        lcretn = "B"
   Case 45761 To 46317
        lcretn = "C"
   Case 46318 To 46825
        lcretn = "D"
   Case 46826 To 47009
        lcretn = "E"
   Case 47010 To 47296
        lcretn = "F"
   Case 47297 To 47613
        lcretn = "G"
   Case 47614 To 48118
        lcretn = "H"
   Case 48119 To 49061
        lcretn = "J"
   Case 49062 To 49323
        lcretn = "K"
   Case 49324 To 49895
        lcretn = "L"
   Case 49896 To 50370
        lcretn = "M"
   Case 50371 To 50613
        lcretn = "N"
   Case 50614 To 50621
        lcretn = "O"
   Case 50622 To 50905
        lcretn = "P"
   Case 50906 To 51386
        lcretn = "Q"
   Case 51387 To 51445
        lcretn = "R"
   Case 51446 To 52217
        lcretn = "S"
   Case 52218 To 52697
        lcretn = "T"
   Case 52698 To 52979
        lcretn = "W"
   Case 52980 To 53688
        lcretn = "X"
   Case 53689 To 54480
        lcretn = "Y"
   Case 54481 To 55359
        lcretn = "Z"
   Case Else
        lcretn = " "
End Select
GET_hzPY = lcretn
End Function

解决方案 »

  1.   

    我们的项目里做过
    '返回汉字简码
    Public Function GetSpellCode(ByVal SourceString As String) As String
        Dim SerialSource As String
        Dim SerialTarget As String
        Dim TempString As String
        Dim j As Integer
        Dim i As Integer
        Dim HelpChar As String
        Dim rsSimpleCode As Recordset     
        SerialSource = "啊芭擦搭蛾发噶哈击喀垃妈拿哦啪期然撒塌挖昔压匝座"
        SerialTarget = "abcdefghjklmnopqrstwxyz"
         
        For i = 1 To Len(SourceString)
            HelpChar = Mid(SourceString, i, 1)
            If Asc(HelpChar) >= Asc(Left(SerialSource, 1)) And Asc(HelpChar) <= Asc(Right(SerialSource, 1)) Then
               If Asc(HelpChar) = Asc(Right(SerialSource, 1)) Then
                  GetSpellCode = UCase(GetSpellCode & Right(SerialTarget, 1))
               Else
                  For j = 2 To Len(SerialSource)
                      TempString = Mid(SerialSource, j, 1)
                      If Asc(HelpChar) < Asc(TempString) Then
                         GetSpellCode = UCase(GetSpellCode & Mid(SerialTarget, j - 1, 1))
                         Exit For
                      End If
                  Next j
               End If
           Else
               If Asc(HelpChar) > 0 Then        '非中文字符
                  GetSpellCode = UCase(GetSpellCode & HelpChar)
               Else
                 Set rsSimpleCode = New Recordset
                 rsSimpleCode.Open "select * from SimpleCode where hz='" & HelpChar & "'", ModuleVar.g_Conn, adOpenStatic, adLockOptimistic
                 If rsSimpleCode.BOF And rsSimpleCode.EOF Then
                   frmSimpleCode.LetCode = HelpChar
                   frmSimpleCode.Show vbModal
                   GetSpellCode = UCase(GetSpellCode & frmSimpleCode.GetCode)
                 Else
                   rsSimpleCode.MoveFirst
                   GetSpellCode = UCase(GetSpellCode & rsSimpleCode("jm"))
                 End If
                 'GetSpellCode = GetSpellCode & "?"
               End If
           End If
       Next i
    End Function
      

  2.   

    我们在编写数据库应用软件时，常常需要设计对人名、地名等各种汉字信息进行查找的功能。
    如果只允许用户输入汉字来查找，会使得查找功能不灵活，不完善；但如果允许用户输入汉
    字的拼音作为查找条件，除了多设一个储存汉字拼音的字段外，最大的问题在于输入资料时
    还得额外输入汉字的拼音，大大增加了输入的工作量。能不能通过编程的手段在输入汉字资
    料时自动产生其对应的拼音，从而解决这个矛盾呢？答案是肯定的，下面介绍的方法就能让
    您轻松实现这个目的，为简单叙述起见，我们假设只需要产生汉字的声母，而不要韵母(无
    声母的则取韵母的第一个字母)。 　　要自动产生拼音，首先必须有个汉字－拼音对照表。去哪里找这个表？可自己动手做一
    个。做表的方法有点复杂，要先用工具生成汉字与拼音对应的文本文件，再用编程的手段将
    需要的内容加在数据表中。下面介绍一种具体的操作方法： 　　第一步，利用“Windows 95附件”中“输入法生成器”的逆转化功能，将拼音输入法的
    码表文件“c:\windows\system\winpy.mb”逆转换为文本文件“c:\winpy.txt”（当然转换
    后的文件任您取名和指定位置）。用写字板打开此文本文件，可以看到这样的文字： 　　[Description] 　　Name=全拼 
    　　MaxCodes=12 
    　　MaxElement=1 
    　　UsedCodes=abcdefghijklmnopqrstuvwxyz 
    　　WildChar=? 
    　　…… 
    　　[Text] 
    　　啊a 
    　　阿a 
    　　…… 
    　　阿爸aba 
    　　阿昌achang 
    　　…… 　　显然，最前面12行此时对于我们来讲是完全无用的，可用手工将之删除。另外，文件中
    还有大量词的编码，如“阿爸aba”、“阿昌achang”等，对我们也是无用的，如何将之去
    掉使得文件中只保留单字及其编码呢？用手工显然太麻烦，只能靠一段小程序了。我们这样
    考虑，如果某行是单字及其编码，则这行的第三个字符肯定是字母，可以取这行的前三个字
    符存放在另一个文件中；而如果某行是词，则第三个字符是汉字的一部分，其ASC值在128以
    上，我们就不用管它。 　　下面给出这段小程序： 　　newfile=Fcreate(′c:\py.txt′)＆＆创建文件，用于储存单字及其编码的文本 
    　　oldfile=Fopen(′c:\winpy.txt′) ＆＆ 打开文件 
    　　Fseek(oldfile, 0) ＆＆ 移动指针到文件头 
    　　Do while not feof(oldfile) 
    　　　　c=left(Fgets(oldfile),3) 
    　　    if asc(right(c,1)) < 128 then 
    　　　　    cc=chr(34)－left(c,2)－chr(34)－″,″－chr(34)－right(c,1)－chr(34) 
            　　 FPUTS(newfile, cc) &&以″字″,″z″ 这样的格式写在新文件里 
    　　　endif　　 
    　　Enddo 
    　　 Fclose(newfile) ＆＆ 关闭文件 
    　　 Fclose(oldfile) ＆＆ 关闭文件 
    　　creat table py (汉字 c(2),拼音 c(1))＆＆创建新表 
    　　use py ＆＆打开此表 
    　　append from c:\py.txt type delimited 
    　　 ＆＆从文本中追加数据 
    　　use 　　运行这段程序后，一个存有汉字和拼音首个字母的表PY就产生了。将这个表加入到我
    们的数据库中，并根据汉字建立索引，就可以使用这个表了。 　　接下来要解决的问题是：输入汉字后，如何将之转换为拼音呢？假设在一个表单里已
    经建立了一个名为“汉字”的文本框用于输入汉字和一个名为“拼音”的文本框用于显示
    汉字对应的拼音。我们可在“汉字”这个文本框的LostFoucs事件中写入如下代码： 　　local a,b,c 
    　　c=″ ″ 
    　　b=″ ″ 
    　　a=thisform.汉字.value 
    　　select py ＆＆假设此表在此之前已经打开且已经指定索引 
    　　for i=2 to len(a) step 2 
    　　 store right(left((a),i),2) to b 
    　　 seek b 
    　　 store c－py.拼音 to c 
    　　next i　　 
    　　thisform.拼音.value=c 　　至此，自动产生拼音的工作可以说成功完成了。至于如何添加在你的资料表上，就不
    必罗嗦了。这个方法为我们设计数据库应用软件带来了极大的好处，希望对大家有点启发
    作用。 
      

  3.   

    http://ygyuan.go.163.com/
    http://ygyuan.3322.net/现成的控件免费下载!