vb6中如何实现：给出一个汉字，求出该汉字拼音的声母。如给出一个“为”字(拼音是wei)，如何得到声母w。

问题有点意思啊，我也不知道正解是什么，不过刚才我写了一段代码，看看是否对你有提示
Private Sub Command1_Click()

     Debug.Print "ASCII 阿="; Asc("阿")
     Debug.Print "ASCII 巴="; Asc("巴")
     Debug.Print "ASCII 擦="; Asc("擦")
     Debug.Print "ASCII 嗒="; Asc("嗒")
     Debug.Print "ASCII 诶="; Asc("诶")
     Debug.Print "ASCII 发="; Asc("发")
     Debug.Print "ASCII 呷="; Asc("呷")
     Debug.Print "ASCII 哈="; Asc("哈")
     Debug.Print "..."
     Debug.Print "ASCII 呀="; Asc("呀")
     Debug.Print "ASCII 咋="; Asc("咋")

End Sub运行结果如下：ASCII 阿=-20318
ASCII 巴=-20275
ASCII 擦=-19775
ASCII 嗒=-8022
ASCII 诶=-9536
ASCII 发=-18526
ASCII 呷=-8248
ASCII 哈=-17922
...
ASCII 呀=-11843
ASCII 咋=-10842

修改刚才的代码如下：
Private Sub Command1_Click()
     Debug.Print "ASCW 阿="; AscW("阿")
     Debug.Print "ASCW 巴="; AscW("巴")
     Debug.Print "ASCW 擦="; AscW("擦")
     Debug.Print "ASCW 嗒="; AscW("嗒")
     Debug.Print "ASCW 诶="; AscW("诶")
     Debug.Print "ASCW 发="; AscW("发")
     Debug.Print "ASCW 呷="; AscW("呷")
     Debug.Print "ASCW 哈="; AscW("哈")
     Debug.Print "..."
     Debug.Print "ASCW 呀="; AscW("呀")
     Debug.Print "ASCW 咋="; AscW("咋")
End Sub运行结果：
ASCW 阿=-27073
ASCW 巴= 24052
ASCW 擦= 25830
ASCW 嗒= 21970
ASCW 诶=-29706
ASCW 发= 21457
ASCW 呷= 21623
ASCW 哈= 21704
...
ASCW 呀= 21568
ASCW 咋= 21643

Private Sub Command1_Click()
     Debug.Print "AscB 阿="; AscB("阿")
     Debug.Print "AscB 巴="; AscB("巴")
     Debug.Print "AscB 擦="; AscB("擦")
     Debug.Print "AscB 嗒="; AscB("嗒")
     Debug.Print "AscB 诶="; AscB("诶")
     Debug.Print "AscB 发="; AscB("发")
     Debug.Print "AscB 呷="; AscB("呷")
     Debug.Print "AscB 哈="; AscB("哈")
     Debug.Print "..."
     Debug.Print "AscB 呀="; AscB("呀")
     Debug.Print "AscB 咋="; AscB("咋")
End Sub
运行结果：
AscB 阿= 63
AscB 巴= 244
AscB 擦= 230
AscB 嗒= 210
AscB 诶= 246
AscB 发= 209
AscB 呷= 119
AscB 哈= 200
...
AscB 呀= 64
AscB 咋= 139

'****************调用******************
MsgBox pysy("为")
'**************模块声明****************
Private Const IME_ESC_MAX_KEY = &H1005
Private Const IME_ESC_IME_NAME = &H1006
Private Const GCL_REVERSECONVERSION = &H2
Private Declare Function GetKeyboardLayoutList Lib "user32" (ByVal nBuff As Long, lpList As Long) As Long
Private Declare Function ImmEscape Lib "imm32.dll" Alias "ImmEscapeA" (ByVal hkl As Long, ByVal himc As Long, ByVal un As Long, lpv As Any) As Long
Private Declare Function ImmGetConversionList Lib "imm32.dll" Alias "ImmGetConversionListA" (ByVal hkl As Long, ByVal himc As Long, ByVal lpsz As String, lpCandidateList As Any, ByVal dwBufLen As Long, ByVal uFlag As Long) As Long
Private Declare Function IsDBCSLeadByte Lib "Kernel32" (ByVal bTestChar As Byte) As Long
Public Function GetChineseSpell(Chinese As String, Optional Delimiter As String = " ", Optional IMEName As String = "微软拼音输入法", Optional BufferSize As Long = 255) As String
If Len(Trim(Chinese)) > 0 Then
Dim i As Long
Dim s As String
s = Space(BufferSize)
Dim IMEInstalled As Boolean
Dim j As Long
Dim a() As Long

ReDim a(BufferSize) As Long
j = GetKeyboardLayoutList(BufferSize, a(LBound(a))) For i = LBound(a) To LBound(a) + j - 1
   If ImmEscape(a(i), 0, IME_ESC_IME_NAME, ByVal s) Then
     If Trim(IMEName) = Replace(Trim(s), Chr(0), "") Then
      IMEInstalled = True
      Exit For
     End If
   End If
Next i
If IMEInstalled Then
   Chinese = Trim(Chinese)
   Dim sChar As String
   Dim Buffer0() As Byte
   Dim bBuffer0() As Byte
   Dim bBuffer() As Byte
   Dim K As Long
   Dim l As Long
   Dim m As Long
   For j = 0 To Len(Chinese) - 1
     sChar = Mid(Chinese, j + 1, 1)
     Buffer0 = StrConv(sChar, vbFromUnicode)
     If IsDBCSLeadByte(Buffer0(0)) Then
      K = ImmEscape(a(i), 0, IME_ESC_MAX_KEY, Null)
      If K Then
        l = ImmGetConversionList(a(i), 0, sChar, 0, 0, GCL_REVERSECONVERSION)
        If l Then
         s = Space(BufferSize)
         If ImmGetConversionList(a(i), 0, sChar, ByVal s, l, GCL_REVERSECONVERSION) Then

           bBuffer0 = StrConv(s, vbFromUnicode)
           ReDim bBuffer(K * 2 - 1)
           For m = bBuffer0(24) To bBuffer0(24) + K * 2 - 1
             bBuffer(m - bBuffer0(24)) = bBuffer0(m)
           Next m
           sChar = Trim(StrConv(bBuffer, vbUnicode))
           If InStr(sChar, vbNullChar) Then
            sChar = Trim(Left(sChar, InStr(sChar, vbNullChar) - 1))
           End If
           sChar = Left(sChar, Len(sChar) - 1) & IIf(j < Len(Chinese) - 1, Delimiter, "")

         End If

        End If
      End If
     End If
     GetChineseSpell = GetChineseSpell & sChar
   Next j
Else
    GetChineseSpell = " "
End If
Else
GetChineseSpell = ""
End If
End FunctionFunction pysy(s0$) As String
Dim i%, K%, k1%, k2%, s$, s1$, a&, s2$

    On Error Resume Next
        K = Len(s0): s = "": s0 = UCase$(s0)
        For i = 1 To K
            s2 = Mid$(s0, i, 1): a = Asc(s2)
            If a < 0 Then
                a = a + 65536
                k1 = a \ 256: k2 = a Mod 256
                K = (k1 - 160) * 100 + k2 - 160
                s1 = ""
                If K > 8794 Then
                    s1 = ""
                ElseIf K >= 5601 Then
                    s1 = GetChineseSpell(s2)
                ElseIf K >= 5249 Then
                    s1 = "Z"
                ElseIf K >= 4925 Then
                    s1 = "Y"
                ElseIf K >= 4684 Then
                    s1 = "X"
                ElseIf K >= 4558 Then
                    s1 = "W"
                ElseIf K >= 4390 Then
                    s1 = "T"
                ElseIf K >= 4086 Then
                    s1 = "S"
                ElseIf K >= 4027 Then
                    s1 = "R"
                ElseIf K >= 3858 Then
                    s1 = "Q"
                ElseIf K >= 3730 Then
                    s1 = "P"
                ElseIf K >= 3722 Then
                    s1 = "O"
                ElseIf K >= 3635 Then
                    s1 = "N"
                ElseIf K >= 3472 Then
                    s1 = "M"
                ElseIf K >= 3212 Then
                    s1 = "L"
                ElseIf K >= 3106 Then
                    s1 = "K"
                ElseIf K >= 2787 Then
                    s1 = "J"
                ElseIf K >= 2594 Then
                    s1 = "H"
                ElseIf K >= 2433 Then
                    s1 = "G"
                ElseIf K >= 2302 Then
                    s1 = "F"
                ElseIf K >= 2274 Then
                    s1 = "E"
                ElseIf K >= 2078 Then
                    s1 = "D"
                ElseIf K >= 1833 Then
                    s1 = "C"
                ElseIf K >= 1637 Then
                    s1 = "B"
                ElseIf K >= 1601 Then
                    s1 = "A"
                End If
                s = s & s1
            Else
                s = s & Chr$(a)
            End If
        Next i
    pysy = s
    On Error GoTo 0
End Function

看看是不是这个
Option Explicit
Dim col As New CollectionPrivate Sub Command1_Click()
Dim str1 As String, ascii As Integer, i As Integer
Dim j As Integer
str1 = Text1.Text
For j = 1 To Len(str1)
    ascii = Asc(Mid(str1, j, 1))
    If ascii < Asc(Left(col.Item(1), 1)) Then
        'Debug.Print "不是简体汉字"
    ElseIf ascii >= Asc("匝") And ascii <= Asc("座") Then
       Debug.Print "Z";
    ElseIf ascii > Asc("座") Then
       ' Debug.Print "不是简体汉字"
    Else
        For i = 1 To col.Count - 1
            If ascii >= Asc(Left(col.Item(i), 1)) And ascii < Asc(Left(col.Item(i + 1), 1)) Then
                Debug.Print Right(col.Item(i), 1);
            End If
        Next i
    End IfNext j
Debug.Print
End SubPrivate Sub Form_Load()
col.Add "啊:A"
col.Add "芭:B"
col.Add "擦:C"
col.Add "搭:D"
col.Add "蛾:E"
col.Add "发:F"
col.Add "噶:G"
col.Add "哈:H"
col.Add "击:J"
col.Add "喀:K"
col.Add "垃:L"
col.Add "妈:M"
col.Add "拿:N"
col.Add "哦:O"
col.Add "啪:P"
col.Add "期:Q"
col.Add "然:R"
col.Add "撒:S"
col.Add "塌:T"
col.Add "挖:W"
col.Add "昔:X"
col.Add "压:Y"
col.Add "匝:Z"
End Sub

下面的网址就是一个例子：
http://smallfairy.51.net/KiteGirl/PYGet.htm

如何求“只”、“吃”、“是”的声母zh、ch、sh（不是求z、c、s）

调试易

vb6中如何实现：给出一个汉字，求出该汉字拼音的声母。如给出一个“为”字(拼音是wei)，如何得到声母w。

解决方案 »