请教如何实现汉字的注音,就想小学课本那样

lj77916 2004-07-31 08:46:40

比如输入汉字"中国"
输出:
zhong guo
中国
这样的输入输出用vb如何实现

...全文

108 2 打赏收藏转发到动态举报

写回复

用AI写文章

2 条回复

切换为时间正序

请发表友善的回复…

发表回复

northwolves 2004-07-31

打赏
举报

Option Explicit

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(ByVal CHINESE As String, Optional PYTYPE As Integer = 0, Optional Delimiter As String = " ") As String

If Len(Trim(CHINESE)) > 0 Then
Dim i As Long
Dim s As String
s = Space(255)
Dim IMEInstalled As Boolean
Dim j As Long
Dim a() As Long

ReDim a(255) As Long
j = GetKeyboardLayoutList(255, 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("微软拼音输入法") = 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)
' If Not InStr("《》，。/？、][{}“”‘’；：！·〈〉「」『』｜〖〗【】（）［］｛｝…—.,""'';:?/\!", sChar) > 0 Then
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(255)
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
End If
End If

End If
End If
' End If
GetChineseSpell = GetChineseSpell & Switch(PYTYPE = 0, sChar, PYTYPE = 1, Left(sChar, Len(sChar) - 1), PYTYPE = 2, UCase(Left(sChar, 1))) & IIf(PYTYPE = 2, "", Delimiter) ''返回全拼
Next j
Else ''没安装“微软拼音输入法”,返回一个空格
GetChineseSpell = " "
End If
Else
GetChineseSpell = "" ''输入为空字符串
End If
End Function

Private Sub Command1_Click()
Dim x As String
x = InputBox("请输入汉字：", "", "中国")
MsgBox GetChineseSpell(x, 1) & vbCrLf & x
End Sub