怎样得到二级字库中一个汉字的拼音首字母(高分求救)？

[思考]

如“涞”(L)、“瑛”(Y)、“璞”(P)等

[用户 昵称]

database??FYI

[zyl910]

直接通过输入法得到拼音



http://expert.csdn.net/Expert/topic/1184/1184794.xml?temp=.224972


回复人： fzx_qd(无底洞) ( ) 信誉：100 2002-11-18 14:16:00 得分:0


各位也不用找了！哥们直接贴出来得了！

'用于实现汉字与拼音转换的类模块

Private Const IME_ESC_MAX_KEY = &H1005
Private Const IME_ESC_IME_NAME = &H1006
Private Const GCL_REVERSECONVERSION = &H2

Private Type CANDIDATELIST
dwSize As Long
dwStyle As Long
dwCount As Long
dwSelection As Long
dwPageStart As Long
dwPageSize As Long
dwOffset(1) As Long
End Type

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

Private Const NUM_OF_BUFFERS = 40
Private Const MSPY = "微软拼音输入法"
Dim imeHandle(1 To NUM_OF_BUFFERS) As Long
Dim imeName(1 To NUM_OF_BUFFERS) As String

Dim mlMSPYIndex As Long
Dim imeCount As Long


Private Sub Init()
Dim i As Long
Dim sName As String

mlMSPYIndex = 0
imeCount = GetKeyboardLayoutList(NUM_OF_BUFFERS, imeHandle(1))
If imeCount Then
For i = 1 To imeCount
sName = String(255, " ")
If ImmEscape(imeHandle(i), 0, IME_ESC_IME_NAME, ByVal sName) Then
If sName <> "" Then sName = Left(sName, InStr(sName, vbNullChar) - 1)
imeName(i) = sName
If sName = MSPY Then
mlMSPYIndex = i
End If
End If
Next i
End If

End Sub




Public Property Get MSPYInstalled() As Boolean
MSPYInstalled = IIf(mlMSPYIndex, True, False)
End Property

Public Property Get MSPYIndex() As Long
MSPYIndex = mlMSPYIndex
End Property

Public Property Get Count() As Long
Count = imeCount
End Property

Public Function GetHandle(ByVal lIndex As Long) As Long
If lIndex >= 1 And lIndex <= imeCount Then
GetHandle = imeHandle(lIndex)
End If
End Function

Public Function GetName(ByVal lIndex As Long) As String
If lIndex >= 1 And lIndex <= imeCount Then
GetName = imeName(lIndex)
End If
End Function

'得到全拼
Public Function GetAllOfPy(ByVal sString As String) As String
On Error GoTo GetAllOfPyErr
Dim lStrLen As Long
Dim i As Long
Dim sChar As String
Dim bChar() As Byte

If MSPYInstalled Then
lStrLen = Len(sString)
GetAllOfPy = ""
If lStrLen Then
For i = 1 To lStrLen
sChar = Mid(sString, i, 1)
bChar = StrConv(sChar, vbFromUnicode)
If IsDBCSLeadByte(bChar(0)) Then
Dim lMaxKey As Long
Dim lGCL As Long

lMaxKey = ImmEscape(imeHandle(mlMSPYIndex), 0, IME_ESC_MAX_KEY, Null)
If lMaxKey Then
Dim tCandi As CANDIDATELIST
lGCL = ImmGetConversionList(imeHandle(mlMSPYIndex), 0, sChar, 0, 0, GCL_REVERSECONVERSION)
If lGCL > 0 Then
Dim bBuffer() As Byte
Dim MaxKey As Long
Dim sBuffer As String
sBuffer = String(255, vbNullChar)
MaxKey = lMaxKey
lGCL = ImmGetConversionList(imeHandle(mlMSPYIndex), 0, sChar, ByVal sBuffer, lGCL, GCL_REVERSECONVERSION)
If lGCL > 0 Then
Dim bPY() As Byte
Dim j As Long

bBuffer = StrConv(sBuffer, vbFromUnicode)

ReDim bPY(MaxKey * 2 - 1)
For j = bBuffer(24) To bBuffer(24) + MaxKey * 2 - 1
bPY(j - bBuffer(24)) = bBuffer(j)
Next j
sChar = StrConv(bPY, vbUnicode)

If InStr(sChar, vbNullChar) Then
sChar = Trim(Left(sChar, InStr(sChar, vbNullChar) - 1))
End If
sChar = Left(sChar, Len(sChar) - 1) & " "
End If
End If
End If
End If
GetAllOfPy = GetAllOfPy & sChar
Next i
End If
Else
GetAllOfPy = sString
End If
Exit Function
GetAllOfPyErr:
GetAllOfPy = sString
End Function

Private Sub Class_Initialize()
Init
End Sub

[思考]

我只需要拼音首字母

[思考]

如"涞璎"返回LY

[思考]

如“涞A璎”返回“LAY”

[zyl910]

已经得到拼音了
你只取前一个字符不就行了