VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
END
Attribute VB_Name = "clsImeConv"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
'かな漢字変換クラス(Excel2000)

'このファイルをプロジェクトにインポートして使ってください。

'使用例
'Sub Test1()
'    Dim ImeConv As New clsImeConv
'    Dim i As Long
'    ImeConv.Yomi = "あした"
'    For i = 1 To ImeConv.Count
'        Debug.Print ImeConv.Item(i)
'    Next
'End Sub
'
'Sub Test2()
'    Dim ImeConv As New clsImeConv
'    Dim s As Variant
'    ImeConv.Kanji = "今日"
'    For Each s In ImeConv.Items
'        Debug.Print s
'    Next
'End Sub

'郵便番号から住所への変換
'
'郵便番号辞書のセットアップが必要です。
'動作しないときは、IMEのプロパティで郵便番号辞書を有効にしてみてください。
'チェックボックスがグレイのチェック状態のときはグレイでないチェック状態にします。
'
'Sub Test3()
'    Dim ImeConv As New clsImeConv
'    ImeConv.Yubin = "100-0004"
'    If ImeConv.Count > 0 Then
'        MsgBox ImeConv.Yubin & " " & ImeConv.Item(1)
'    End If
'End Sub


Option Explicit

Private Const GCL_CONVERSION = 1
Private Const GCL_REVERSECONVERSION = 2

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

Private Declare Function ImmGetDefaultIMEWnd Lib "imm32.dll" (ByVal hwnd As Long) As Long
Private Declare Function ImmGetContext Lib "imm32" (ByVal hwnd As Long) As Long
Private Declare Function ImmReleaseContext Lib "imm32" (ByVal hwnd As Long, ByVal hIMC As Long) As Long
Private Declare Function ImmGetConversionList Lib "imm32" Alias "ImmGetConversionListW" _
    (ByVal hKL As Long, ByVal hIMC As Long, ByRef lpSrc As Any, _
    ByRef lpDst As Any, ByVal dwBufLen As Long, ByVal uFlag As Long) As Long
Private Declare Function ImmSetConversionStatus Lib "imm32.dll" _
    (ByVal hIMC As Long, ByVal dwConversion As Long, ByVal dwSentence As Long) As Long
Private Declare Function ImmGetConversionStatus Lib "imm32.dll" _
    (ByVal hIMC As Long, ByRef dwConversion As Long, ByRef dwSentence As Long) As Long
Private Declare Function GetKeyboardLayout Lib "user32" (ByVal dwLayout As Long) As Long

Private Const VER_PLATFORM_WIN32_WINDOWS = 1
Private Const VER_PLATFORM_WIN32_NT = 2

Private Type OSVERSIONINFO
    dwOSVersionInfoSize As Long
    dwMajorVersion As Long
    dwMinorVersion As Long
    dwBuildNumber As Long
    dwPlatformId As Long
    szCSDVersion(127) As Byte
End Type

Private Declare Function GetVersionEx Lib "kernel32" Alias "GetVersionExA" _
    (ByRef lpVersionInformation As OSVERSIONINFO) As Long

Private Declare Sub MoveMemory Lib "kernel32" Alias "RtlMoveMemory" _
    (ByRef Destination As Any, ByRef Source As Any, ByVal Length As Long)

Private g_Result() As String
Private g_Yomi     As String
Private g_Kanji    As String
Private g_SMode    As Long


Private Const IME_CMODE_NATIVE = &H1

'入力モード
Public Enum IME_CMODE_ENUM
    IME_CMODE_ALPHANUMERIC = &H0
    IME_CMODE_JAPANESE = IME_CMODE_NATIVE
    IME_CMODE_KATAKANA = &H2
    IME_CMODE_LANGUAGE = &H3
    IME_CMODE_FULLSHAPE = &H8
    IME_CMODE_ROMAN = &H10
    IME_CMODE_CHARCODE = &H20
    IME_CMODE_HANJACONVERT = &H40
    IME_CMODE_SOFTKBD = &H80
    IME_CMODE_NOCONVERSION = &H100
    IME_CMODE_EUDC = &H200
    IME_CMODE_SYMBOL = &H400
    IME_CMODE_FIXED = &H800
End Enum

'変換モード
Public Enum IME_SMODE_ENUM
    IME_SMODE_NONE = &H0           '無変換
    IME_SMODE_PLAURALCLAUSE = &H1  '人名/地名
'    IME_SMODE_SINGLECONVERT = &H2
    IME_SMODE_AUTOMATIC = &H4      '一般
'    IME_SMODE_PHRASEPREDICT = &H8
    IME_SMODE_CONVERSATION = &H10  '話し言葉優先
End Enum

Public Property Get Item(ByVal Index As Long) As String
    On Error Resume Next
    Item = g_Result(Index - 1)
    On Error GoTo 0
End Property

Public Property Get Items() As Variant
    Dim i As Long
    On Error Resume Next
    i = -1
    i = UBound(g_Result)
    If i = -1 Then Items = Array() Else Items = g_Result
    On Error GoTo 0
End Property

Public Property Get Count() As Long
    On Error Resume Next
    Count = UBound(g_Result) + 1
    On Error GoTo 0
End Property

Public Property Get Yomi() As String
    Yomi = g_Yomi
End Property

Public Property Get Kanji() As String
    Kanji = g_Kanji
End Property

Public Property Let IME_SMode(ByVal SMode As IME_SMODE_ENUM)
    g_SMode = SMode
End Property

Public Property Get IME_SMode() As IME_SMODE_ENUM
    IME_SMode = g_SMode
End Property

Public Property Let Yomi(ByVal strSrc As String)
    Erase g_Result
    g_Yomi = strSrc
    g_Kanji = ""
    Convert strSrc, GCL_CONVERSION
End Property

Public Property Let Kanji(ByVal strSrc As String)
    Erase g_Result
    g_Kanji = strSrc
    g_Yomi = ""
    Convert strSrc, GCL_REVERSECONVERSION
End Property

Public Property Let Yubin(ByVal strSrc As String)
    Dim i As Long
    Dim n As Long
    Dim s As String
    
    Erase g_Result
    g_Yomi = strSrc
    g_Kanji = ""
    If Not (strSrc Like "###-####") Then Exit Property
    Convert strSrc, GCL_CONVERSION
    On Error Resume Next
    n = -1
    n = UBound(g_Result)
    For i = 0 To n
        s = g_Result(i)
        If Mid(s, 3, 2) Like "*[都道府県]*" Then
            If s Like "*##" Then s = Left$(s, Len(s) - 2)
            ReDim g_Result(0 To 0)
            g_Result(0) = s
            Exit Property
        End If
    Next
    Erase g_Result
End Property

Public Property Get Yubin() As String
    Yubin = g_Yomi
End Property

Private Sub Convert(strSrc As String, uFlag As Long)
    Dim bytSrc()     As Byte
    Dim dwSize       As Long
    Dim bytCand()    As Byte
    Dim strCand      As String
    Dim dwOffset     As Long
    Dim dwCount      As Long
    Dim dwConversion As Long
    Dim dwSentence   As Long
    Dim lngResult    As Long
    Dim hwnd         As Long
    Dim hIMC         As Long
    Dim hKL          As Long
    Dim osvi         As OSVERSIONINFO
    Dim i            As Long

    If strSrc = "" Then Exit Sub
    osvi.dwOSVersionInfoSize = Len(osvi)
    lngResult = GetVersionEx(osvi)
    If osvi.dwPlatformId = VER_PLATFORM_WIN32_NT Then
        bytSrc = strSrc & vbNullChar
    Else
        bytSrc = StrConv(strSrc & vbNullChar, vbFromUnicode)
    End If
    hwnd = ImmGetDefaultIMEWnd(0&)
    hIMC = ImmGetContext(hwnd)

    If g_SMode <> -1 Then
        lngResult = ImmGetConversionStatus(hIMC, dwConversion, dwSentence)
        lngResult = ImmSetConversionStatus(hIMC, dwConversion, g_SMode)
    End If

    hKL = GetKeyboardLayout(0)
    dwSize = ImmGetConversionList(hKL, hIMC, bytSrc(0), ByVal 0&, 0, uFlag)
    If dwSize > 0 Then
        ReDim bytCand(dwSize)
        dwSize = ImmGetConversionList(hKL, hIMC, bytSrc(0), bytCand(0), dwSize, uFlag)
        MoveMemory dwCount, bytCand(8), 4
        If dwCount > 0 Then
            strCand = bytCand
            ReDim g_Result(dwCount - 1)
            For i = 0 To dwCount - 1
                MoveMemory dwOffset, bytCand(24 + i * 4), 4
                g_Result(i) = MidB(strCand, dwOffset + 1)
                g_Result(i) = Left(g_Result(i), InStr(1, g_Result(i), vbNullChar, 0) - 1)
            Next
        End If
    End If

    If g_SMode <> -1 Then
        lngResult = ImmSetConversionStatus(hIMC, dwConversion, dwSentence)
    End If
    lngResult = ImmReleaseContext(hwnd, hIMC)
End Sub

Private Sub Class_Initialize()
    g_SMode = -1
End Sub