[XL]日本語入力システムのオン / オフを制御する方法

詳細

1. サンプル モジュール

ボタン 1 に登録するマクロ

  Sub Button_ON_OFF()
      Select Case IMEStatus
      Case 2
          IMEControl 1
      Case Else
          IMEControl 2
      End Select
  End Sub

マクロ IMEControl

  Option Explicit
  Private Declare Function lstrcpynS2M Lib "KERNEL" Alias "lstrcpyn" _
      (ByVal lpszString1 As Long, ByVal lpszString2 As String, _
      ByVal cChars As Integer) As Long
  Private Declare Function lstrcpynM2S Lib "KERNEL" Alias "lstrcpyn" _
      (ByVal lpszString1 As String, ByVal lpszString2 As Long, _
      ByVal cChars As Integer) As Long
  Private Declare Function GlobalAlloc Lib "KERNEL" _
      (ByVal wFlags As Integer, ByVal dwBytes As Long) As Integer
  Private Declare Function GlobalFree Lib "KERNEL" (ByVal hMem As _
      Integer) As Integer
  Private Declare Function GlobalLock Lib "KERNEL" (ByVal hMem As _
      Integer) As Long
  Private Declare Function GlobalUnLock Lib "KERNEL" (ByVal hMem As _
      Integer) As Integer
  Private Declare Function SendIMEMessage Lib "WINNLS" (ByVal wnd As _
      Integer, ByVal wParam As Long) As Integer
  ' IMEControl Sub
  '
  ' 書式: IMEControl(nMode As Integer)
  ' 解説: IME を制御します。
  '
  ' nMode
  '   1 オン
  '   2 オフ
  Public Sub IMEControl(ByVal nMode As Integer)
      Dim nRet As Integer
      Dim nMode1 As Integer
      Dim nMode2 As Integer
      Dim hMem As Integer
      Dim szDat As String
      Select Case nMode
      Case 1
          nRet = IMEControlSub(1)
      Case 2
          nRet = IMEControlSub(0)
          nMode2 = 1
      Case Else
          nMode1 = 0
          nMode2 = 1
      End Select
      If nMode2 = 0 Then
          nRet = IMEControlSub(1)
          nRet = DoEvents()
          szDat = Chr$(&h10) & Chr$(0) & Chr$(nMode1) & Chr$(nMode2)
          hMem = GlobalAlloc(&h3002, 64)
          MemCopy szDat, hMem, 4
          nRet = SendIMEMessage(0, hMem)
          MemCopy hMem, szDat, 4
          nRet = GlobalFree(hMem)
      End If
  End Sub
  Function IMEControlSub(ByVal nFunc As Integer) As Integer
      Dim nRet As Integer
      Dim hMem As Integer
      Dim szDat As String
      nRet = DoEvents()
      If nFunc = -1 Then
          szDat = Chr$(5) & Chr$(0) & Chr$(0) & Chr$(0)
      ElseIf nFunc <> 0 Then
          szDat = Chr$(4) & Chr$(0) & Chr$(nFunc) & Chr$(0)
      Else
          szDat = Chr$(4) & Chr$(0) & Chr$(nFunc) & Chr$(0)
      End If
      hMem = GlobalAlloc(&h3002, 64)
      MemCopy szDat, hMem, 4
      nRet = SendIMEMessage(0, hMem)
      MemCopy hMem, szDat, 4
      nRet = GlobalFree(hMem)
      IMEControlSub = Asc(MidB(szDat, 3, 1))
  End Function
  Private Sub MemCopy(vSrc As Variant, vDst As Variant, wBytes As _
      Integer)
      Dim i As Integer
      Dim lAddG As Long
      Dim lRet As Long
      Dim szTmp As String
      If VarType(vSrc) = 8 And VarType(vDst) = 2 Then
          lAddG = GlobalLock(vDst)
          For i = 0 To wBytes - 1
              szTmp = MidB(vSrc, i + 1, 1) & Chr$(0)
            lRet = lstrcpynS2M(i + lAddG, szTmp, 2)
          Next
          lRet = GlobalUnLock(vDst)
      ElseIf VarType(vSrc) = 2 And VarType(vDst) = 8 Then
          lAddG = GlobalLock(vSrc)
          vDst = ""
          szTmp = Chr$(0) & Chr$(0)
          For i = 0 To wBytes - 1
              lRet = lstrcpynM2S(szTmp, lAddG + CLng(i), 2)
              vDst = vDst & LeftB(szTmp, 1)
          Next
          lRet = GlobalUnLock(vSrc)
      Else
          Stop
      End If
  End Sub

2. 関連情報