[VB2] IME をリアルタイムに制御する方法

概要

Visual Basic for Windows 2.0 は IMEMode プロパティにより IME の状態を変更
させることは可能ですが、この変更は次にそのコントロールがフォーカスを受けた
ときに有効になります。つまり、あるコントロールにフォーカスをおいたまま
IME の状態を変更させることはできません。この IMEControl プロシージャは、
実行することで (その場で) IME の状態を変更することが可能です。

サンプル

フォーム ファイル (IMECtrl.Frm)

  VERSION 2.00
  Begin Form frmIMECtrl
     BorderStyle     =   1  '固定 (実線)
     Caption         =   "IME 制御サンプル"
     Height          =   2310
     Left            =   1230
     MaxButton       =   0   'False
     ScaleHeight     =   1935
     ScaleWidth      =   4230
     Top             =   1470
     Width           =   4320
     Begin TextBox txtInput
        Height          =   405
        Left            =   240
        TabIndex        =   2
        Top             =   240
        Width           =   3735
     End
     Begin HScrollBar hsbIMECtrl
        Height          =   270
        Left            =   240
        Max             =   9
        Min             =   1
        TabIndex        =   0
        TabStop         =   0   'False
        Top             =   1320
        Value           =   1
        Width           =   3735
     End
     Begin Label lblIMECtrl
        AutoSize        =   -1  'True
        Caption         =   "IMEControl"
        Height          =   270
        Left            =   240
        TabIndex        =   3
        Top             =   840
        Width           =   1140
     End
     Begin Label lblIMECtrlNo
        Height          =   255
        Left            =   1440
        TabIndex        =   1
        Top             =   840
        Width           =   495
     End
  End
  Sub Form_Load ()
      hsbIMECtrl.Value = IMEStatus
      lblIMECtrlNo = hsbIMECtrl.Value
  End Sub
  Sub hsbIMECtrl_Change ()
      lblIMECtrlNo = hsbIMECtrl.Value
      IMEControl hsbIMECtrl.Value
  End Sub

モジュール ファイル (IMECtrl.Bas)

  Option Explicit
  Declare Function lstrcpynS2M Lib "Kernel" Alias "lstrcpyn" (ByVal lpszString1
   As Long, ByVal lpszString2 As String, ByVal cChars As Integer) As Long
  Declare Function lstrcpynM2S Lib "Kernel" Alias "lstrcpyn" (ByVal lpszString1
   As String, ByVal lpszString2 As Long, ByVal cChars As Integer) As Long
  Declare Function GlobalAlloc Lib "Kernel" (ByVal wFlags As Integer, ByVal dwB
  ytes As Long) As Integer
  Declare Function GlobalFree Lib "Kernel" (ByVal hMem As Integer) As Integer
  Declare Function GlobalLock Lib "Kernel" (ByVal hMem As Integer) As Long
  Declare Function GlobalUnLock Lib "Kernel" (ByVal hMem As Integer) As Integer
  Declare Function SendIMEMessage Lib "WINNLS" (ByVal wnd As Integer, ByVal wPa
  ram As Long) As Integer
  '
  ' IMEControl Sub
  '
  ' 書式: IMEControl(nMode As Integer)
  ' 解説: IME を制御します。
  '
  ' nMode
  '   1 オン
  '   2 オフ
  '   3 オフ（オフ固定にはしていません。2 と同じ動作をします。）
  '   4 ひらがな全角
  '   5 カナ全角
  '   6 カナ半角
  '   7 英数全角
  '   8 英数半角
  '   9 コード入力
  '
  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, 3
          nRet = IMEControlSub(0)
          nMode2 = 1
      Case 4
          nMode1 = &H34
          nMode2 = 0
      Case 5
          nMode1 = &H32
          nMode2 = 0
      Case 6
          nMode1 = &H2A
          nMode2 = 0
      Case 7
          nMode1 = &H51
          nMode2 = 0
      Case 8
          nMode1 = &H49
          nMode2 = 0
      Case 9
          nMode1 = &H80
          nMode2 = 0
      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