文書番号: 410497
最終更新日: 1999/03/21
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
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
Keywords: KBHOWTO KB410497
Technology: kbAudDeveloper kbVBSearch