发信人: cobe()
整理人: winsy(2003-03-05 16:32:51), 站内信件
|
-----------下面的代码是同事写的，很有意思，偷偷贴出来，大家分享-------
Public Function GetChineseSpellCode(ByVal SourceStr As String) As Stri
ng
'得到中文的拼音缩写
Dim Serial_S As String
Dim Serial_T As String
Dim TempS As String
Dim j As Integer
Dim i As Integer
Dim HelpChar As String
Serial_S = "啊芭擦搭蛾发噶哈击喀垃妈拿哦啪期然撒塌挖昔压匝座"
Serial_T = "abcdefghjklmnopqrstwxyz"
For i = 1 To Len(SourceStr)
HelpChar = Mid(SourceStr, i, 1)
If Asc(HelpChar) >= Asc(Left(Serial_S, 1)) And Asc(HelpChar) <
= Asc(Right(Serial_S, 1)) Then
'-------------------------------
If Asc(HelpChar) = Asc(Right(Serial_S, 1)) Then
GetChineseSpellCode = GetHelpCode & Right(Serial_T
, 1)
Else
For j = 2 To Len(Serial_S)
TempS = Mid(Serial_S, j, 1)
If Asc(HelpChar) < Asc(TempS) Then
GetChineseSpellCode = GetChineseSpellC
ode & Mid(Serial_T, j - 1, 1)
Exit For
End If
Next j
End If
'-------------------------------
Else
GetHelpCode = GetHelpCode & "?"
End If
Next i
End Function
--
没办法！！我也有不会的呀！！！你就告诉我吧~~~
※ 来源:．月光软件站 http://www.moon-soft.com．[FROM: 202.130.227.1]
|
|