拼音简码怎么做?

Question

如题.现在发现许多管理系统都用上了拼音简码,不知道是怎么做的?

Answer 1

这是MS提供的一个类:  MultiUse = -1  'True
  Persistable = 0  'NotPersistable
  DataBindingBehavior = 0  'vbNone
  DataSourceBehavior = 0   'vbNone
  MTSTransactionMode = 0   'NotAnMTSObject
End
Private Const IME_ESC_MAX_KEY = &H1005
Private Const IME_ESC_IME_NAME = &H1006
Private Const GCL_REVERSECONVERSION = &H2Private 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 TypePrivate 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 LongPrivate 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 StringDim 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 IfEnd Sub
Public Property Get MSPYInstalled() As Boolean
    MSPYInstalled = IIf(mlMSPYIndex, True, False)
End PropertyPublic Property Get MSPYIndex() As Long
    MSPYIndex = mlMSPYIndex
End PropertyPublic Property Get Count() As Long
    Count = imeCount
End PropertyPublic Function GetHandle(ByVal lIndex As Long) As Long
    If lIndex >= 1 And lIndex <= imeCount Then
        GetHandle = imeHandle(lIndex)
    End If
End FunctionPublic 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 FunctionPrivate Sub Class_Initialize()
    Init
End Sub也可以自己做,你留下EMAIL,我发给你.