查看: 11  |  回复: 0
  VB6 代码管家-取汉语拼音首字母
楼主
发表于 2024年12月8日 22:24
Public Function py(mystr As String) As String
    If Asc(mystr) < 0 Then
        If Asc(Left$(mystr, 1)) < Asc("啊") Then
            py = "0"
            Exit Function
        End If
        If Asc(Left$(mystr, 1)) >= Asc("啊") And Asc(Left$(mystr, 1)) < Asc("芭") Then
            py = "A"
            Exit Function
        End If
        If Asc(Left$(mystr, 1)) >= Asc("芭") And Asc(Left$(mystr, 1)) < Asc("擦") Then
            py = "B"
            Exit Function
        End If
        If Asc(Left$(mystr, 1)) >= Asc("擦") And Asc(Left$(mystr, 1)) < Asc("搭") Then
            py = "C"
            Exit Function
        End If
        If Asc(Left$(mystr, 1)) >= Asc("搭") And Asc(Left$(mystr, 1)) < Asc("蛾") Then
            py = "D"
            Exit Function
        End If
        If Asc(Left$(mystr, 1)) >= Asc("蛾") And Asc(Left$(mystr, 1)) < Asc("发") Then
            py = "E"
            Exit Function
        End If
        If Asc(Left$(mystr, 1)) >= Asc("发") And Asc(Left$(mystr, 1)) < Asc("噶") Then
            py = "F"
            Exit Function
        End If
        If Asc(Left$(mystr, 1)) >= Asc("噶") And Asc(Left$(mystr, 1)) < Asc("哈") Then
            py = "G"
            Exit Function
        End If
        If Asc(Left$(mystr, 1)) >= Asc("哈") And Asc(Left$(mystr, 1)) < Asc("击") Then
            py = "H"
            Exit Function
        End If
        If Asc(Left$(mystr, 1)) >= Asc("击") And Asc(Left$(mystr, 1)) < Asc("喀") Then
            py = "J"
            Exit Function
        End If
        If Asc(Left$(mystr, 1)) >= Asc("喀") And Asc(Left$(mystr, 1)) < Asc("垃") Then
            py = "K"
            Exit Function
        End If
        If Asc(Left$(mystr, 1)) >= Asc("垃") And Asc(Left$(mystr, 1)) < Asc("妈") Then
            py = "L"
            Exit Function
        End If
        If Asc(Left$(mystr, 1)) >= Asc("妈") And Asc(Left$(mystr, 1)) < Asc("拿") Then
            py = "M"
            Exit Function
        End If
        If Asc(Left$(mystr, 1)) >= Asc("拿") And Asc(Left$(mystr, 1)) < Asc("哦") Then
            py = "N"
            Exit Function
        End If
        If Asc(Left$(mystr, 1)) >= Asc("哦") And Asc(Left$(mystr, 1)) < Asc("啪") Then
            py = "O"
            Exit Function
        End If
        If Asc(Left$(mystr, 1)) >= Asc("啪") And Asc(Left$(mystr, 1)) < Asc("期") Then
            py = "P"
            Exit Function
        End If
        If Asc(Left$(mystr, 1)) >= Asc("期") And Asc(Left$(mystr, 1)) < Asc("然") Then
            py = "Q"
            Exit Function
        End If
        If Asc(Left$(mystr, 1)) >= Asc("然") And Asc(Left$(mystr, 1)) < Asc("撒") Then
            py = "R"
            Exit Function
        End If
        If Asc(Left$(mystr, 1)) >= Asc("撒") And Asc(Left$(mystr, 1)) < Asc("塌") Then
            py = "S"
            Exit Function
        End If
        If Asc(Left$(mystr, 1)) >= Asc("塌") And Asc(Left$(mystr, 1)) < Asc("挖") Then
            py = "T"
            Exit Function
        End If
        If Asc(Left$(mystr, 1)) >= Asc("挖") And Asc(Left$(mystr, 1)) < Asc("昔") Then
            py = "W"
            Exit Function
        End If
        If Asc(Left$(mystr, 1)) >= Asc("昔") And Asc(Left$(mystr, 1)) < Asc("压") Then
            py = "X"
            Exit Function
        End If
        If Asc(Left$(mystr, 1)) >= Asc("压") And Asc(Left$(mystr, 1)) < Asc("匝") Then
            py = "Y"
            Exit Function
        End If
        If Asc(Left$(mystr, 1)) >= Asc("匝") Then
            py = "Z"
            Exit Function
        End If
    Else
        If UCase$(mystr) <= "Z" And UCase$(mystr) >= "A" Then
            py = UCase$(Left$(mystr, 1))
        Else
            py = mystr
        End If
    End If
End Function

Public Function test(str As String) As String
    Dim tmp As String
    For i = 1 To Len(str)
        tmp = tmp & py(Mid$(str, i, 1))
    Next i
    test = tmp
End Function
'-----------------------以上也可直接放到模块里-----------------------

Private Sub Form_Load()
Text1 = test("你好,我是中国人") '输出结果
'如果输入的是小写字母,也会通通转成大写字母
End Sub


您需要登录后才可以回帖 登录 | 立即注册
【本版规则】请勿发表违反国家法律的内容,否则会被冻结账号和删贴。
用户名: 立即注册
密码:
2020-2024 MaNongKu.com