Option Compare Database
Option Explicit

'ime
'(ImmConfigureIME)
Type RegisterWord
  lpReading As String
  lpWord As String
End Type

'  dialog mode of ImmConfigureIME
Public Const IME_CONFIG_GENERAL = 1             'IMEプロパティーダイアログ
Public Const IME_CONFIG_REGISTERWORD = 2        '単語登録ダイアログ
Public Const IME_CONFIG_SELECTDICTIONARY = 3    'システム辞書選択ダイアログ
'                                           4   'IME辞書ツール(Win95+IME97で確認、Win95+IME2000では「dlg辞書選択」が実行される

'  bit field for conversion mode                        '===入力モード
Public Const IME_CMODE_ALPHANUMERIC = &H0               '英数字入力モード
Public Const IME_CMODE_NATIVE = &H1                     'NATIVE（日本語）入力モード
Public Const IME_CMODE_CHINESE = IME_CMODE_NATIVE       '
Public Const IME_CMODE_HANGEUL = IME_CMODE_NATIVE       '
Public Const IME_CMODE_JAPANESE = IME_CMODE_NATIVE      '
Public Const IME_CMODE_KATAKANA = &H2                   'カタカナモード（OFFはひらがなモード）
Public Const IME_CMODE_LANGUAGE = &H3                   '
Public Const IME_CMODE_FULLSHAPE = &H8                  '全角モード（OFFは半角モード）
Public Const IME_CMODE_ROMAN = &H10                     'ローマ字入力
Public Const IME_CMODE_CHARCODE = &H20                  '文字コード入力
Public Const IME_CMODE_HANJACONVERT = &H40              '
Public Const IME_CMODE_SOFTKBD = &H80                   '
Public Const IME_CMODE_NOCONVERSION = &H100             '無変換（OFFは変換）
Public Const IME_CMODE_EUDC = &H200                     '
Public Const IME_CMODE_SYMBOL = &H400                   '
                                                        '===変換方式
Public Const IME_SMODE_NONE = &H0                       'なし
Public Const IME_SMODE_PLAURALCLAUSE = &H1              '複文節変換
Public Const IME_SMODE_SINGLECONVERT = &H2              '単漢字変換
Public Const IME_SMODE_AUTOMATIC = &H4                  '自動変換
Public Const IME_SMODE_PHRASEPREDICT = &H8              'フレーズ予測ってIE変換？？？

'IMEのファイル名を取得
Declare Function ImmGetIMEFileName Lib "imm32.dll" Alias "ImmGetIMEFileNameA" (ByVal hkl As Long, ByVal lpStr As String, ByVal uBufLen As Long) As Long
'IMEの説明文を取得
Declare Function ImmGetDescription Lib "imm32.dll" Alias "ImmGetDescriptionA" (ByVal hkl As Long, ByVal lpsz As String, ByVal uBufLen As Long) As Long
'IMEが開いているか
Declare Function ImmGetOpenStatus Lib "imm32.dll" (ByVal hIMC As Long) As Long
'指定ウィンドウの入力コンテキストハンドル取得
Declare Function ImmGetContext Lib "imm32.dll" (ByVal hWnd As Long) As Long
'IMEの現在の入力変換方式
Declare Function ImmGetConversionStatus Lib "imm32.dll" (ByVal hIMC As Long, lpdw As Long, lpdw2 As Long) As Long
'ハンドルを開放
Declare Function ImmReleaseContext Lib "imm32.dll" (ByVal hWnd As Long, ByVal hIMC As Long) As Long
'IMEの設定ダイアログボックス表示（単語登録）
Declare Function ImmConfigureIME Lib "imm32.dll" Alias "ImmConfigureIMEA" (ByVal hkl As Long, ByVal hWnd As Long, ByVal dwMode As Long, wd As RegisterWord) As Long
'IMEの設定ダイアログボックス表示
Declare Function ImmConfigureIMELong Lib "imm32.dll" Alias "ImmConfigureIMEA" (ByVal hkl As Long, ByVal hWnd As Long, ByVal dwMode As Long, ByVal dw As Long) As Long

Declare Function GetKeyboardLayout Lib "USER32" (ByVal dwLayout As Long) As Long

'IMEのオン・オフを切り替え
Public Const IME_JHOTKEY_CLOSE_OPEN = &H30        'IME をオープン・クローズする
Declare Function ImmSimulateHotKey Lib "IMM32" (ByVal hWnd As Long, ByVal dwHotKeyID As Long) As Long

Dim fm As Form

Function fmIMEOpen()
    Set fm = Forms!fmIME
End Function

Function cmdImmGetConversionStatus()
    'IMEの現在の入力変換方式
    Dim RtnCd As Long
    Dim hIMC As Long, lpdw As Long, lpdw2 As Long
    
    hIMC = ImmGetContext(fm.hWnd)
    RtnCd = ImmGetConversionStatus(hIMC, lpdw, lpdw2)
    RtnCd = ImmReleaseContext(fm.hWnd, hIMC)
    
    With fm
        !実行結果 = IIf((lpdw And IME_CMODE_NATIVE), "NATIVE", "英数字") & "入力モード" & Hex(lpdw)
        !実行結果 = !実行結果 & vbCrLf & IIf((lpdw And IME_CMODE_KATAKANA), "カタカナ", "ひらがな") & "モード"
        !実行結果 = !実行結果 & vbCrLf & IIf((lpdw And IME_CMODE_FULLSHAPE), "全角", "半角") & "モード"
        !実行結果 = !実行結果 & vbCrLf & IIf((lpdw And IME_CMODE_ROMAN), "ローマ字", "カナ") & "入力"
        
        !実行結果 = !実行結果 & vbCrLf & IIf((lpdw2 And IME_SMODE_PHRASEPREDICT), "IE変換？？？ ", "")
        !実行結果 = !実行結果 & IIf((lpdw2 And IME_SMODE_AUTOMATIC), "自動変換 ", "")
        !実行結果 = !実行結果 & IIf((lpdw2 And IME_SMODE_SINGLECONVERT), "単漢字変換 ", "")
        !実行結果 = !実行結果 & IIf((lpdw2 And IME_SMODE_PLAURALCLAUSE), "複文節変換 ", "")
    End With
End Function

Function cmdImmGetOpenStatus()
    'IMEが開いているか
    Dim RtnCd As Long, hIMC As Long
    
    hIMC = ImmGetContext(fm.hWnd)
    RtnCd = ImmGetOpenStatus(hIMC)
    
    fm!実行結果 = "ＩＭＥ＝ " & IIf(RtnCd = 0, "Off", "On")
End Function

Function cmdImmGetIMEFileName()
    'IMEのファイル名を取得
    Dim RtnCd As Long, hkl As Long
    Dim lpStr As String, uBufLen As Long
    
    hkl = GetKeyboardLayout(0)
    
    'ファイル名のバイト数を取得（uBufLenにゼロを設定）
    uBufLen = ImmGetIMEFileName(hkl, vbNullString, 0)
    lpStr = String(uBufLen + 1, vbNullChar)
    RtnCd = ImmGetIMEFileName(hkl, lpStr, uBufLen + 1)
    
    fm!実行結果 = "IMEファイル名＝" & NullCharConv(lpStr)
End Function

Function cmdImmGetDescription()
  'IMEの説明文を取得
  Dim RtnCd As Long, hkl As Long
  Dim lpsz As String, uBufLen As Long
  
  hkl = GetKeyboardLayout(0)

  '説明文のバイト数を取得（uBufLenにゼロを設定）
  uBufLen = ImmGetDescription(hkl, vbNullString, 0)
  lpsz = String(uBufLen + 1, vbNullChar)
  RtnCd = ImmGetDescription(hkl, lpsz, uBufLen + 1)
  
  fm!実行結果 = "IME 説明文  " & NullCharConv(lpsz)
End Function

Private Function NullCharConv(strVal As String) As String
    'Null文字削除
    Dim i As Integer
    
    i = InStr(strVal, vbNullChar)
    If i < 2 Then
        NullCharConv = strVal
    Else
        NullCharConv = Left$(strVal, i - 1)
    End If
End Function

Function dlgプロパティー()
    'プロパティーダイアログボックス
    Dim RtnCd As Long, hkl As Long
    
    hkl = GetKeyboardLayout(0)
    RtnCd = ImmConfigureIMELong(hkl, fm.hWnd, IME_CONFIG_GENERAL, 0)
End Function

Function dlg辞書ツール()
    '辞書ツールダイアログボックス(Win95+IME97で確認)
    '(Win95+IME2000では「dlg辞書選択」が実行される)
    'Apiの定数にはありません
    Dim RtnCd As Long, hkl As Long
    
    hkl = GetKeyboardLayout(0)
    RtnCd = ImmConfigureIMELong(hkl, fm.hWnd, 4, 0)
End Function

Function dlg単語登録()
    '単語登録ダイアログボックス
    Dim RtnCd As Long, hkl As Long
    Dim wd As RegisterWord
    
    hkl = GetKeyboardLayout(0)
    '単語登録ダイアログボックスの「読み」と「語句」の初期値を設定
    'lpReadingには半角カナを入れる(Win95+IME97で確認、Win95+IME2000では「読み」に表示されません)
    wd.lpReading = "ﾛｰﾄﾞ"
    wd.lpWord = "ロードシステム"
    RtnCd = ImmConfigureIME(hkl, fm.hWnd, IME_CONFIG_REGISTERWORD, wd)
End Function

Function dlg辞書選択()
  Dim RtnCd As Long, hkl As Long

  hkl = GetKeyboardLayout(0)
  RtnCd = ImmConfigureIMELong(hkl, fm.hWnd, IME_CONFIG_SELECTDICTIONARY, 0)
End Function

Function ImeOnOff()
    'テキストボックス「実行結果」をクリックするたびに、IMEのオン・オフを切り替え
    Dim RtnCd As Long

    RtnCd = ImmSimulateHotKey(fm.hWnd, IME_JHOTKEY_CLOSE_OPEN)
End Function