标题: [分享]在输入“济南”时，输入拼音代码“jn”就可以！！ [打印本页] 作者: zhaobeaut 时间: 2002-12-11 18:54 标题: [分享]在输入“济南”时，输入拼音代码“jn”就可以！！ 文件下载
可以输入拼音代码来输入名称，，，，
并且在代码栏可以根据上面输入的车次自动选择到站！！！[em06]作者: 李啸林 时间: 2002-12-12 16:52
我还以为你的拼音代码“jn”，是自动生成的。原来是用一字段[简码]手工输入来实现。作者: zhaobeaut 时间: 2002-12-15 18:34
那怎么能自动实现呢，,,,作者: acc 时间: 2002-12-22 05:40
抄自别人处：不记得出处了。真对不起原作者
也许对你有用
取得汉字的拼音首字
用以下的函数可以得到汉字的拼音首字字符，注意：对 噢、杞、
嘌、呤 是个例外。
对很多汉字无法正确的实现转换，
原因是在该程序根据汉字在编码表中的位置来判断的，
而部分的汉字所在的位置有误，所以 。。。。
Public Function GetPY(a1 As String) As String
Dim t1 As String
If Asc(a1) < 0 Then
t1 = Left(a1, 1)
If Asc(t1) < Asc("啊") Then
GetPY = "0"
Exit Function
End If
If Asc(t1) >= Asc("啊") And Asc(t1) < Asc("芭") Then
GetPY = "A"
Exit Function
End If
If Asc(t1) >= Asc("芭") And Asc(t1) < Asc("擦") Then
GetPY = "B"
Exit Function
End If
If Asc(t1) >= Asc("擦") And Asc(t1) < Asc("搭") Then
GetPY = "C"
Exit Function
End If
If Asc(t1) >= Asc("搭") And Asc(t1) < Asc("蛾") Then
GetPY = "D"
Exit Function
End If
If Asc(t1) >= Asc("蛾") And Asc(t1) < Asc("发") Then
GetPY = "E"
Exit Function
End If
If Asc(t1) >= Asc("发") And Asc(t1) < Asc("噶") Then
GetPY = "F"
Exit Function
End If
If Asc(t1) >= Asc("噶") And Asc(t1) < Asc("哈") Then
GetPY = "G"
Exit Function
End If
If Asc(t1) >= Asc("哈") And Asc(t1) < Asc("击") Then
GetPY = "H"
Exit Function
End If
If Asc(t1) >= Asc("击") And Asc(t1) < Asc("喀") Then
GetPY = "J"
Exit Function
End If
If Asc(t1) >= Asc("喀") And Asc(t1) < Asc("垃") Then
GetPY = "K"
Exit Function
End If
If Asc(t1) >= Asc("垃") And Asc(t1) < Asc("妈") Then
GetPY = "L"
Exit Function
End If
If Asc(t1) >= Asc("妈") And Asc(t1) < Asc("拿") Then
GetPY = "M"
Exit Function
End If
If Asc(t1) >= Asc("拿") And Asc(t1) < Asc("哦") Then
GetPY = "N"
Exit Function
End If
If Asc(t1) >= Asc("哦") And Asc(t1) < Asc("啪") Then
GetPY = "O"
Exit Function
End If
If Asc(t1) >= Asc("啪") And Asc(t1) < Asc("期") Then
GetPY = ""
Exit Function
End If
If Asc(t1) >= Asc("期") And Asc(t1) < Asc("然") Then
GetPY = "Q"
Exit Function
End If
If Asc(t1) >= Asc("然") And Asc(t1) < Asc("撒") Then
GetPY = "R"
Exit Function
End If
If Asc(t1) >= Asc("撒") And Asc(t1) < Asc("塌") Then
GetPY = "S"
Exit Function
End If
If Asc(t1) >= Asc("塌") And Asc(t1) < Asc("挖") Then
GetPY = "T"
Exit Function
End If
If Asc(t1) >= Asc("挖") And Asc(t1) < Asc("昔") Then
GetPY = "W"
Exit Function
End If
If Asc(t1) >= Asc("昔") And Asc(t1) < Asc("压") Then
GetPY = "X"
Exit Function
End If
If Asc(t1) >= Asc("压") And Asc(t1) < Asc("匝") Then
GetPY = "Y"
Exit Function
End If
If Asc(t1) >= Asc("匝") Then
GetPY = "Z"
Exit Function
End If
Else
If UCase(a1) <= "Z" And UCase(a1) >= "A" Then
GetPY = UCase(Left(a1, 1))
Else
GetPY = "0"
End If
End If
End Function 作者: 竹笛 时间: 2002-12-23 02:02
嘻嘻~~~~~~~，我也抄一个，从WTM1那里抄来的，这是获取第一个声母：
Public Function PinYin(Tstr As String) As String
Dim i As Long, p As Integer
i = Asc(Tstr)
If i >= Asc("啊") And i < Asc("芭") Then p = 65
If i >= Asc("芭") And i < Asc("擦") Then p = 66
If i >= Asc("擦") And i < Asc("搭") Then p = 67
If i >= Asc("搭") And i < Asc("蛾") Then p = 68
If i >= Asc("蛾") And i < Asc("发") Then p = 69
If i >= Asc("发") And i < Asc("噶") Then p = 70
If i >= Asc("噶") And i < Asc("哈") Then p = 71
If i >= Asc("哈") And i < Asc("击") Then p = 72
If i >= Asc("击") And i < Asc("喀") Then p = 74
If i >= Asc("喀") And i < Asc("垃") Then p = 75
If i >= Asc("垃") And i < Asc("妈") Then p = 76
If i >= Asc("妈") And i < Asc("拿") Then p = 77
If i >= Asc("拿") And i < Asc("哦") Then p = 78
If i >= Asc("哦") And i < Asc("啪") Then p = 79
If i >= Asc("啪") And i < Asc("欺") Then p = 80
If i >= Asc("欺") And i < Asc("然") Then p = 81
If i >= Asc("然") And i < Asc("撒") Then p = 82
If i >= Asc("撒") And i < Asc("塌") Then p = 83
If i >= Asc("塌") And i < Asc("挖") Then p = 84
If i >= Asc("挖") And i < Asc("昔") Then p = 87
If i >= Asc("昔") And i < Asc("压") Then p = 88
If i >= Asc("压") And i < Asc("匝") Then p = 89
If i >= Asc("匝") And i <= Asc("座") Then p = 90
PinYin = Chr(p)
End Function 作者: 竹笛 时间: 2002-12-23 02:04
例子在此！文件下载作者: huanghai 时间: 2002-12-23 05:50
NORTHNWIND的，哈哈作者: jiangyi 时间: 2003-2-6 20:27
蒙人呢!作者: cogolv 时间: 2006-7-29 08:13
谢谢分享
"