タイトル | : Re^2: SetWindowLongの動作 |
記事No | : 11853 |
投稿日 | : 2017/06/21(Wed) 11:14 |
投稿者 | : KH |
魔界の仮面弁士様、ご回答ありがとうございます。
いろいろ勉強不足でわからないことだらけですが、 教えていただきましたYomigana Frameworkや、データ型の違いなど 調べてみようと思います。
あと以下のソースがVB6で動作していた元のソースになりますので、 ご確認よろしくお願いします。
●入力フォームの文字入力部分 Private Sub Kanji_KeyDown(KeyCode As Integer, Shift As Integer) Module1.KeyDownEdit Kanji, Kana End Sub
●フリガナ取得部分(Module1.bas) Private fEditing As Boolean Private m_txtSrc As Object Private m_txtDest As Object Private m_lpOrg As Long Public Const GCS_RESULTREADSTR = &H200 Public Const GCS_RESULTSTR = &H800 Public Const WM_IME_COMPOSITION = &H10F Public Const GWL_WNDPROC = (-4) Public Const WM_CHAR = &H102
Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long Declare Function ImmGetContext Lib "imm32.dll" (ByVal hwnd As Long) As Long Declare Function ImmGetCompositionString Lib "imm32.dll" Alias "ImmGetCompositionStringA" (ByVal hIMC As Long, ByVal dw As Long, lpv As Any, ByVal dw2 As Long) As Long Private m_StrConvMode As Long Declare Function ImmReleaseContext Lib "imm32.dll" (ByVal hwnd As Long, ByVal hIMC As Long) As Long Declare Function ImmGetOpenStatus Lib "imm32.dll" (ByVal hIMC As Long) As Long Public Const WM_KEYUP = &H101 Declare Function CallWindowProc Lib "user32" Alias "CallWindowProcA" (ByVal lpPrevWndFunc As Long, ByVal hwnd As Long, ByVal msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Public Sub EndEdit() '(メソッド)IMEふりがな入力の監視を終了する If fEditing = True Then '終了処理 fEditing = False m_lpOrg = SetWindowLong(m_txtSrc.hwnd, GWL_WNDPROC, m_lpOrg) End If End Sub
Public Sub KeyDownEdit(txtSrc As Object, txtDest As Object) '(メソッド)キーボード入力のたびにふりがな入力を監視する 'KeyDownイベントから呼び出します 'txtSrc 漢字を入力するテキストボックス 'txtDest ふりがなを自動入力するテキストボックス 'ふりがな監視/終了 StartEdit txtSrc, txtDest DoEvents EndEdit '連動消去 If m_txtSrc.Text = "" Then m_txtDest.Text = ""
End Sub
Public Sub StartEdit(txtSrc As Object, txtDest As Object) '(メソッド)IMEふりがな入力の監視を開始する 'txtSrc 漢字を入力するテキストボックス 'txtDest ふりがなを自動入力するテキストボックス '--準備 If fEditing = True Then Call EndEdit 'EndEditを忘れている場合の処理 Set m_txtSrc = txtSrc Set m_txtDest = txtDest fEditing = True '--サブクラス化開始 m_lpOrg = SetWindowLong(m_txtSrc.hwnd, GWL_WNDPROC, AddressOf pWindowProc) End Sub
Public Function pWindowProc(ByVal hwnd As Long, ByVal uMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long '[サブクラス化処理]メッセージを監視してふりがなを入力 '(外部から呼び出さないでください) Static fCalling As Boolean Dim hIMC& Dim dwSize& Dim MyByte() As Byte Dim MyRead$, MyResult$, MyStr$ Dim ConvMode&
If fCalling = False Then fCalling = True Select Case uMsg 'IME入力中にふりがなを得る Case WM_IME_COMPOSITION hIMC = ImmGetContext(hwnd) '表記(確定文字が全角英数の場合に使用) dwSize = ImmGetCompositionString(hIMC, GCS_RESULTSTR, ByVal 0&, 0) ReDim MyByte(dwSize) ImmGetCompositionString hIMC, GCS_RESULTSTR, MyByte(0), dwSize MyResult$ = MyByte() MyResult$ = StrConv(MyResult$, vbUnicode) If Not MyResult$ = Chr$(0) Then 'よみ dwSize = ImmGetCompositionString(hIMC, GCS_RESULTREADSTR, ByVal 0&, 0) ReDim MyByte(dwSize) ImmGetCompositionString hIMC, GCS_RESULTREADSTR, MyByte(0), dwSize MyRead$ = MyByte() MyRead$ = StrConv(MyRead$, vbUnicode) '追加する文字種の判断 If chrIsNarrow(StrConv(MyResult$, vbNarrow)) Then MyStr$ = MyResult$ Else MyStr$ = MyRead$ 'テキストを追加 ConvMode = IIf(m_StrConvMode = 0, vbNarrow, m_StrConvMode) MyStr$ = Left$(MyStr$, Len(MyStr$) - 1) '最後のNullを取る MyStr$ = StrConv(MyStr$, ConvMode) 'ふりがなの種類 'ふりがなの挿入位置 If m_txtSrc.SelStart > 0 Then m_txtDest.Text = m_txtDest.Text & MyStr$ '末尾にふりがなを追加 If m_txtSrc.SelStart = 0 Then m_txtDest.Text = MyStr$ & m_txtDest.Text '先頭の場合はふりがなも先頭に追加 End If ImmReleaseContext hwnd, hIMC Case WM_CHAR '半角英語 hIMC = ImmGetContext(hwnd) If ImmGetOpenStatus(hIMC) = 0 Then '半角入力モードのときだけ If wParam >= 32 Then '制御キャラクタは無視 m_txtDest.Text = m_txtDest.Text & Chr$(wParam) End If End If Call ImmReleaseContext(hwnd, hIMC) Case WM_KEYUP '操作キー(連動消去) If wParam = vbKeyBack Or wParam = vbKeyDelete Then 'キーでの削除監視 If m_txtSrc.Text = "" Then m_txtDest.Text = "" End If End Select fCalling = False End If
pWindowProc = CallWindowProc(m_lpOrg, hwnd, uMsg, wParam, lParam) End Function
Public Function chrIsNarrow(Target As String) As Boolean
Dim NowPt&, nPt&, NowCode& Dim fNarrow As Boolean
fNarrow = True nPt = Len(Target) For NowPt = 1 To nPt NowCode = Asc(Mid$(Target, NowPt, 1)) If NowCode < 0 Or NowCode > 255 Then fNarrow = False Exit For End If Next NowPt
chrIsNarrow = fNarrow
End Function
|