当输入一个汉字时,如何返回它的拼音的第一个字母。。

liangzhunyu 2004-12-21 01:49:40
好急
...全文
372 9 打赏 收藏 转发到动态 举报
写回复
用AI写文章
9 条回复
切换为时间正序
请发表友善的回复…
发表回复
liangzhunyu 2004-12-21
  • 打赏
  • 举报
回复
以上的方法哪种是最好的??
Summer006 2004-12-21
  • 打赏
  • 举报
回复
另外说一下。我的那个,求不出三级码(就是很复杂的汉字)。。[不过平时也少有用。]
遇到时返回的是空白“ ”{原码有但效率低下被我删了}


Summer006 2004-12-21
  • 打赏
  • 举报
回复
这个是我用的。哈哈。 效率应该说还是比较高。
看起来也蛮简单的哈哈。
Public Function GetTextFirstLetter(strText As String) As String
'求出一字串的全部首字母
Dim t As Integer
Dim strTempLetters As String
For t = 1 To Len(strText)
strTempLetters = strTempLetters + GetCharFirstLetter(Asc(Mid(strText, t, 1)))
Next
GetTextFirstLetter = strTempLetters
End Function

Private Function GetCharFirstLetter(intChar As Integer) As String
'求出单个汉字的首字母,内部调用
'输入汉字asc码,输出首字母
Select Case intChar
Case Is >= 0: GetCharFirstLetter = Chr(intChar)
Case Is >= -10246: GetCharFirstLetter = " "
Case Is >= -11055: GetCharFirstLetter = "Z"
Case Is >= -11847: GetCharFirstLetter = "Y"
Case Is >= -12556: GetCharFirstLetter = "X"
Case Is >= -12838: GetCharFirstLetter = "W"
Case Is >= -13318: GetCharFirstLetter = "T"
Case Is >= -14090: GetCharFirstLetter = "S"
Case Is >= -14149: GetCharFirstLetter = "R"
Case Is >= -14630: GetCharFirstLetter = "Q"
Case Is >= -14914: GetCharFirstLetter = "P"
Case Is >= -14922: GetCharFirstLetter = "O"
Case Is >= -15165: GetCharFirstLetter = "N"
Case Is >= -15640: GetCharFirstLetter = "M"
Case Is >= -16212: GetCharFirstLetter = "L"
Case Is >= -16474: GetCharFirstLetter = "K"
Case Is >= -17417: GetCharFirstLetter = "J"
Case Is >= -17922: GetCharFirstLetter = "H"
Case Is >= -18239: GetCharFirstLetter = "G"
Case Is >= -18526: GetCharFirstLetter = "F"
Case Is >= -18710: GetCharFirstLetter = "E"
Case Is >= -19218: GetCharFirstLetter = "D"
Case Is >= -19775: GetCharFirstLetter = "C"
Case Is >= -20283: GetCharFirstLetter = "B"
Case Is >= -20319: GetCharFirstLetter = "A"
Case Else: GetCharFirstLetter = " "
End Select
End Function
faib920 2004-12-21
  • 打赏
  • 举报
回复
Public Function ChinesePronounce(ByVal Chinese As String, Optional Lower As Boolean = False) As String
'将汉字转换拼音首字母
On Error GoTo er
Dim hz As String
Dim MyHzm As Integer
Dim Qm As Integer
Dim Wm As Integer
Dim HzNm As String
Dim I As Integer
Dim TmpStr As String
hz = Chinese
For I = 1 To Len(hz)
TmpStr = Mid(hz, I, 1)
MyHzm = Asc(TmpStr)
If MyHzm >= 0 And MyHzm < 256 Then
If MyHzm = 32 Then GoTo er
If Lower Then ChinesePronounce = ChinesePronounce + LCase(TmpStr) Else ChinesePronounce = ChinesePronounce + UCase(TmpStr): GoTo er
Else
Qm = (MyHzm + 65536) \ 256
Wm = (MyHzm + 65536) Mod 256
HzNm = TenTo(Qm, 16) & TenTo(Wm, 16)
End If
If "B0A1" <= HzNm And HzNm <= "B0C4" Then
If Lower Then ChinesePronounce = ChinesePronounce + "a" Else ChinesePronounce = ChinesePronounce + "A"
ElseIf "B0C5" <= HzNm And HzNm <= "B2C0" Then
If Lower Then ChinesePronounce = ChinesePronounce + "b" Else ChinesePronounce = ChinesePronounce + "B"
ElseIf "B2C1" <= HzNm And HzNm <= "B4ED" Then
If Lower Then ChinesePronounce = ChinesePronounce + "c" Else ChinesePronounce = ChinesePronounce + "C"
ElseIf "B4EE" <= HzNm And HzNm <= "B6E9" Then
If Lower Then ChinesePronounce = ChinesePronounce + "d" Else ChinesePronounce = ChinesePronounce + "D"
ElseIf "B6EA" <= HzNm And HzNm <= "B7A1" Then
If Lower Then ChinesePronounce = ChinesePronounce + "e" Else ChinesePronounce = ChinesePronounce + "E"
ElseIf "B7A2" <= HzNm And HzNm <= "B8C0" Then
If Lower Then ChinesePronounce = ChinesePronounce + "f" Else ChinesePronounce = ChinesePronounce + "F"
ElseIf "B8C1" <= HzNm And HzNm <= "B9FD" Then
If Lower Then ChinesePronounce = ChinesePronounce + "g" Else ChinesePronounce = ChinesePronounce + "G"
ElseIf "B9FE" <= HzNm And HzNm <= "BBF6" Then
If Lower Then ChinesePronounce = ChinesePronounce + "h" Else ChinesePronounce = ChinesePronounce + "H"
ElseIf "BBF7" <= HzNm And HzNm <= "BFA5" Then
If Lower Then ChinesePronounce = ChinesePronounce + "j" Else ChinesePronounce = ChinesePronounce + "J"
ElseIf "BFA6" <= HzNm And HzNm <= "C0AB" Then
If Lower Then ChinesePronounce = ChinesePronounce + "k" Else ChinesePronounce = ChinesePronounce + "K"
ElseIf "C0AC" <= HzNm And HzNm <= "C2E7" Then
If Lower Then ChinesePronounce = ChinesePronounce + "l" Else ChinesePronounce = ChinesePronounce + "L"
ElseIf "C2E8" <= HzNm And HzNm <= "C4C2" Then
If Lower Then ChinesePronounce = ChinesePronounce + "m" Else ChinesePronounce = ChinesePronounce + "M"
ElseIf "C4C3" <= HzNm And HzNm <= "C5B5" Then
If Lower Then ChinesePronounce = ChinesePronounce + "n" Else ChinesePronounce = ChinesePronounce + "N"
ElseIf "C5B6" <= HzNm And HzNm <= "C5BD" Then
If Lower Then ChinesePronounce = ChinesePronounce + "o" Else ChinesePronounce = ChinesePronounce + "O"
ElseIf "C5BE" <= HzNm And HzNm <= "C6D9" Then
If Lower Then ChinesePronounce = ChinesePronounce + "p" Else ChinesePronounce = ChinesePronounce + "P"
ElseIf "C6DA" <= HzNm And HzNm <= "C8BA" Then
If Lower Then ChinesePronounce = ChinesePronounce + "q" Else ChinesePronounce = ChinesePronounce + "Q"
ElseIf "C8BB" <= HzNm And HzNm <= "C8F5" Then
If Lower Then ChinesePronounce = ChinesePronounce + "r" Else ChinesePronounce = ChinesePronounce + "R"
ElseIf "C8F6" <= HzNm And HzNm <= "CBF9" Then
If Lower Then ChinesePronounce = ChinesePronounce + "s" Else ChinesePronounce = ChinesePronounce + "S"
ElseIf "CBFA" <= HzNm And HzNm <= "CDD9" Then
If Lower Then ChinesePronounce = ChinesePronounce + "t" Else ChinesePronounce = ChinesePronounce + "T"
ElseIf "CDDA" <= HzNm And HzNm <= "CEF3" Then
If Lower Then ChinesePronounce = ChinesePronounce + "w" Else ChinesePronounce = ChinesePronounce + "W"
ElseIf "CEF4" <= HzNm And HzNm <= "D188" Then
If Lower Then ChinesePronounce = ChinesePronounce + "x" Else ChinesePronounce = ChinesePronounce + "X"
ElseIf "D1B9" <= HzNm And HzNm <= "D4D0" Then
If Lower Then ChinesePronounce = ChinesePronounce + "y" Else ChinesePronounce = ChinesePronounce + "Y"
ElseIf "D4D1" <= HzNm And HzNm <= "D7F9" Then
If Lower Then ChinesePronounce = ChinesePronounce + "z" Else ChinesePronounce = ChinesePronounce + "Z"
Else
ChinesePronounce = ChinesePronounce + HzNm
End If
Next
er:
If Err.Number <> 0 Then ChinesePronounce = vbNullChar
End Function

Private Function TenTo(M As Integer, N As Integer) As String
Dim Q As Integer
Dim R As Integer
TenTo = ""
Dim bStr As String
Do
Call myDivide(M, N, Q, R)
If R > 9 Then
bStr = Chr(55 + R)
Else
bStr = Str(R)
End If
TenTo = Trim(bStr) & TenTo
M = Q
Loop While Q <> 0
End Function


Private Sub myDivide(num1 As Integer, num2 As Integer, Q As Integer, R As Integer)
If num2 = 0 Then Exit Sub
If num1 / num2 >= 0 Then
Q = Int(num1 / num2)
Else
Q = Int(num1 / num2) + 1
End If
R = num1 Mod num2
End Sub
maskdata 2004-12-21
  • 打赏
  • 举报
回复
up
fxy_2002 2004-12-21
  • 打赏
  • 举报
回复
这问题...需要考虑一下多音字。

长 -> 你是要得到 C (chang),还是Z (zhang) ? 这是个问题。
lyvvvv 2004-12-21
  • 打赏
  • 举报
回复
看看这个http://community.csdn.net/Expert/topic/3258/3258116.xml?temp=.6120417
northwolves 2004-12-21
  • 打赏
  • 举报
回复
Function pinyin(ByVal x As String) As String
Const hanzi = "啊芭擦搭蛾发噶哈击喀垃妈拿哦啪期然撒塌挖昔压匝座ABCDEFGHJKLMNOPQRSTWXYZZ"
If x = "座" Then pinyin = "Z"
For i = 1 To 23
If Asc(x) >= Asc(Mid(hanzi, i, 1)) And Asc(x) < Asc(Mid(hanzi, i + 1, 1)) Then pinyin = Mid(hanzi, 24 + i, 1)
Next
End Function
AprilSong 2004-12-21
  • 打赏
  • 举报
回复
以前别人贴的……

Public Function GetPY(a1 As String) As String '返回拼音码字符串

'输入参数:a1 输入字符串

Dim Jsqte As Long
Dim t1 As String
GetPY = ""
If Len(Trim(a1)) = 0 Then
Exit Function
End If
For Jsqte = 1 To Len(Trim(a1))
t1 = Mid(a1, Jsqte, 1)
If Asc(t1) < 0 Then
If Asc(t1) < Asc("啊") Then
GetPY = GetPY + t1
GoTo L1
End If
If Asc(t1) >= Asc("啊") And Asc(t1) < Asc("芭") Then
GetPY = GetPY + "A"
GoTo L1
End If
If Asc(t1) >= Asc("芭") And Asc(t1) < Asc("擦") Then
GetPY = GetPY + "B"
GoTo L1
End If
If Asc(t1) >= Asc("擦") And Asc(t1) < Asc("搭") Then
GetPY = GetPY + "C"
GoTo L1
End If
If Asc(t1) >= Asc("搭") And Asc(t1) < Asc("蛾") Then
GetPY = GetPY + "D"
GoTo L1
End If
If Asc(t1) >= Asc("蛾") And Asc(t1) < Asc("发") Then
GetPY = GetPY + "E"
GoTo L1
End If
If Asc(t1) >= Asc("发") And Asc(t1) < Asc("噶") Then
GetPY = GetPY + "F"
GoTo L1
End If
If Asc(t1) >= Asc("噶") And Asc(t1) < Asc("哈") Then
GetPY = GetPY + "G"
GoTo L1
End If
If Asc(t1) >= Asc("哈") And Asc(t1) < Asc("击") Then
GetPY = GetPY + "H"
GoTo L1
End If
If Asc(t1) >= Asc("击") And Asc(t1) < Asc("喀") Then
GetPY = GetPY + "J"
GoTo L1
End If
If Asc(t1) >= Asc("喀") And Asc(t1) < Asc("垃") Then
GetPY = GetPY + "K"
GoTo L1
End If
If Asc(t1) >= Asc("垃") And Asc(t1) < Asc("妈") Then
GetPY = GetPY + "L"
GoTo L1
End If
If Asc(t1) >= Asc("妈") And Asc(t1) < Asc("拿") Then
GetPY = GetPY + "M"
GoTo L1
End If
If Asc(t1) >= Asc("拿") And Asc(t1) < Asc("哦") Then
GetPY = GetPY + "N"
GoTo L1
End If
If Asc(t1) >= Asc("哦") And Asc(t1) < Asc("啪") Then
GetPY = GetPY + "O"
GoTo L1
End If
If Asc(t1) >= Asc("啪") And Asc(t1) < Asc("期") Then
GetPY = GetPY + "P"
GoTo L1
End If
If Asc(t1) >= Asc("期") And Asc(t1) < Asc("然") Then
GetPY = GetPY + "Q"
GoTo L1
End If
If Asc(t1) >= Asc("然") And Asc(t1) < Asc("撒") Then
GetPY = GetPY + "R"
GoTo L1
End If
If Asc(t1) >= Asc("撒") And Asc(t1) < Asc("塌") Then
GetPY = GetPY + "S"
GoTo L1
End If
If Asc(t1) >= Asc("塌") And Asc(t1) < Asc("挖") Then
GetPY = GetPY + "T"
GoTo L1
End If
If Asc(t1) >= Asc("挖") And Asc(t1) < Asc("昔") Then
GetPY = GetPY + "W"
GoTo L1
End If
If Asc(t1) >= Asc("昔") And Asc(t1) < Asc("压") Then
GetPY = GetPY + "X"
GoTo L1
End If
If Asc(t1) >= Asc("压") And Asc(t1) < Asc("匝") Then
GetPY = GetPY + "Y"
GoTo L1
End If
If Asc(t1) >= Asc("匝") Then
GetPY = GetPY + "Z"
GoTo L1
End If
Else
If UCase(t1) <= "Z" And UCase(t1) >= "A" Then
GetPY = GetPY + UCase(t1)
Else
GetPY = t1
End If
End If
L1:
Next Jsqte

End Function

7,762

社区成员

发帖
与我相关
我的任务
社区描述
VB 基础类
社区管理员
  • VB基础类社区
加入社区
  • 近7日
  • 近30日
  • 至今
社区公告
暂无公告

试试用AI创作助手写篇文章吧