tagCANDY CGI VBレスキュー(花ちゃん) の Visual Basic 2010 用 掲示板(VB.NET 掲示板)
VBレスキュー(花ちゃん) の Visual Basic 2010 用 掲示板(VB.NET 掲示板)
[ツリー表示へ]　 [ワード検索]　 [Home]

タイトル ： Re^2: SetWindowLongの動作
投稿日： 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
- 関連一覧ツリー （ をクリックするとツリー全体を一括表示します）

古いスレッドにレスはつけられません。