如何调用输入法,得到汉字的拼音
2007-04-24 23:47
417 查看
' 由汉字获取拼音,需要安装微软拼音输入法
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(Chinese As String, Optional Delimiter As String = " ", Optional IMEName As String = "微软拼音输入法", Optional BufferSize As Long = 255) As String
If VBA.Len(VBA.Trim(Chinese)) > 0 Then
Dim i As Long
Dim s As String
s = VBA.Space(BufferSize)
Dim IMEInstalled As Boolean
Dim j As Long
Dim a() As Long
ReDim a(BufferSize) As Long
j = GetKeyboardLayoutList(BufferSize, 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 VBA.Trim(IMEName) = VBA.Replace(VBA.Trim(s), VBA.Chr(0), "") Then
IMEInstalled = True
Exit For
End If
End If
Next i
If IMEInstalled Then
'Stop
Chinese = VBA.Trim(Chinese)
Dim sChar As String
Dim Buffer0() As Byte
'Dim Buffer() 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 VBA.Len(Chinese) - 1
sChar = VBA.Mid(Chinese, j + 1, 1)
Buffer0 = VBA.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 = VBA.Space(BufferSize)
If ImmGetConversionList(a(i), 0, sChar, ByVal s, l, GCL_REVERSECONVERSION) Then
bBuffer0 = VBA.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 = VBA.Trim(VBA.StrConv(bBuffer, vbUnicode))
If VBA.InStr(sChar, vbNullChar) Then
sChar = VBA.Trim(VBA.Left(sChar, VBA.InStr(sChar, vbNullChar) - 1))
End If
sChar = VBA.Left(sChar, VBA.Len(sChar) - 1) & VBA.IIf(j < VBA.Len(Chinese) - 1, Delimiter, "")
End If
End If
End If
End If
GetChineseSpell = GetChineseSpell & sChar
Next j
Else
End If
End If
End Function
Private Sub Command1_Click()
VBA.MsgBox GetChineseSpell("接分")
End Sub
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(Chinese As String, Optional Delimiter As String = " ", Optional IMEName As String = "微软拼音输入法", Optional BufferSize As Long = 255) As String
If VBA.Len(VBA.Trim(Chinese)) > 0 Then
Dim i As Long
Dim s As String
s = VBA.Space(BufferSize)
Dim IMEInstalled As Boolean
Dim j As Long
Dim a() As Long
ReDim a(BufferSize) As Long
j = GetKeyboardLayoutList(BufferSize, 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 VBA.Trim(IMEName) = VBA.Replace(VBA.Trim(s), VBA.Chr(0), "") Then
IMEInstalled = True
Exit For
End If
End If
Next i
If IMEInstalled Then
'Stop
Chinese = VBA.Trim(Chinese)
Dim sChar As String
Dim Buffer0() As Byte
'Dim Buffer() 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 VBA.Len(Chinese) - 1
sChar = VBA.Mid(Chinese, j + 1, 1)
Buffer0 = VBA.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 = VBA.Space(BufferSize)
If ImmGetConversionList(a(i), 0, sChar, ByVal s, l, GCL_REVERSECONVERSION) Then
bBuffer0 = VBA.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 = VBA.Trim(VBA.StrConv(bBuffer, vbUnicode))
If VBA.InStr(sChar, vbNullChar) Then
sChar = VBA.Trim(VBA.Left(sChar, VBA.InStr(sChar, vbNullChar) - 1))
End If
sChar = VBA.Left(sChar, VBA.Len(sChar) - 1) & VBA.IIf(j < VBA.Len(Chinese) - 1, Delimiter, "")
End If
End If
End If
End If
GetChineseSpell = GetChineseSpell & sChar
Next j
Else
End If
End If
End Function
Private Sub Command1_Click()
VBA.MsgBox GetChineseSpell("接分")
End Sub
相关文章推荐
- 如何得到汉字的拼音首字母呢?
- c#中如何得到汉字的拼音首字母
- 如何根据汉字得到响应的拼音(转)
- c#中如何得到汉字的拼音首字母
- SQL Server中如何把一个任意汉字转换为该汉字拼音第一个字母
- C#中汉字轻松得到拼音全文类
- 根据区位得到汉字拼音首字母(c#)
- 扩展类库:使用微软的 Visual Studio International Pack 1.0 进行网站简体与繁体的互转和得到汉字、拼音、笔画等相关信息
- 如何通过UDF实现查询汉字拼音的首字母?
- 如何调用Symbian的输入法控件
- 使用微软的 Visual Studio International Pack 1.0 进行网站简体与繁体的互转和得到汉字、拼音、笔画等相关信息
- android如何调用显示和隐藏系统默认的输入法
- IOS 如何获取汉字字符串的拼音
- Archlinux 下系统如何设置让 Wine 调用 ibus输入法
- 如何在Java中取汉字拼音的首字母
- 在C#中调用一个dll函数,其中有个参数为 hdc,如何在C#中得到这个值并传给这个参数呢?
- 汉字转拼音或得到首字母----源码
- android如何调用显示和隐藏系统默认的输入法
- android如何调用显示和隐藏系统默认的输入法(一)
- 利用汉字在计算机里面的编码来得到汉字的首拼音: