VB6.0用掲示板の過去のログ(No.2)−VBレスキュー(花ちゃん)
[記事リスト] [新規投稿] [新着記事] [ワード検索] [管理用]

投稿日: 2006/02/13(Mon) 16:17
投稿者じゅん
Eメール
URL
タイトルRe^4: フリガナ取得いついて

返事送れてすみません。以下コード修正いたします。
●以下モジュールのコード
Option Explicit
'Ime制御
Public Declare Function ImmGetContext Lib "imm32.dll" (ByVal hWnd As Long) As Long
Public Declare Function ImmSetOpenStatus Lib "imm32.dll" (ByVal himc As Long, ByVal b As
Long) As Long
Public Declare Function ImmGetCompositionString Lib "imm32.dll"
Alias "ImmGetCompositionStringA" (ByVal himc As Long, ByVal dw As Long, ByVal lpv As String,
ByVal dw2 As Long) As Long
Public Declare Function ImmReleaseContext Lib "imm32.dll" (ByVal hWnd As Long, ByVal himc As
Long) As Long

Public Const GCS_COMPREADSTR = &H1
Public Const GCS_COMPREADATTR = &H2
Public Const GCS_COMPREADCLAUSE = &H4
Public Const GCS_COMPSTR = &H8
Public Const GCS_COMPATTR = &H10
Public Const GCS_COMPCLAUSE = &H20
Public Const GCS_CURSORPOS = &H80
Public Const GCS_DELTASTART = &H100
Public Const GCS_RESULTREADSTR = &H200
Public Const GCS_RESULTREADCLAUSE = &H400
Public Const GCS_RESULTSTR = &H800
Public Const GCS_RESULTCLAUSE = &H1000

'イベント処理関連
Public 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 Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hWnd As
Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long

Public Const GWL_WNDPROC = (-4)
Public Const WM_IME_COMPOSITION = &H10F

'保存用変数
Public FURIGANA_STR As String
Public Save_WindowLong As Long
Public Save_hWnd As Long

Public Function GetFurigana(ByVal hWnd As Long, ByVal uMsg As Long, ByVal wParam As Long,
ByVal lParam As Long) As Long
    
    Dim himc As Long
    Dim nLEN As Long
    Dim WorkStr As String
    
    'IME文字確定後で文字が入力された場合
    If (uMsg = WM_IME_COMPOSITION) And ((lParam And GCS_RESULTREADSTR) <> 0) Then
        'フリガナを取得
        'コンテキスト取得
        himc = ImmGetContext(hWnd)
        'バッフア確保のため入力した文字数を取得
        nLEN = ImmGetCompositionString(himc, GCS_RESULTREADSTR, vbNullChar, 0)
        '入力文字数分バッファ確保
        WorkStr = Space(nLEN + 1)
        '入力文字列取得
        Call ImmGetCompositionString(himc, GCS_RESULTREADSTR, WorkStr, nLEN + 1)
        'コンテキスト開放
        Call ImmReleaseContext(hWnd, himc)
        
        FURIGANA_STR = FURIGANA_STR & RTrim(WorkStr)
    End If

    GetFurigana = CallWindowProc(Save_WindowLong, hWnd, uMsg, wParam, lParam)
    
End Function

Public Sub Furigana_Start(KANJI_Control As Control)

    'フリガナ監視スタート
    
    'GetFuriganaイベントをバインドしてます。
    Save_WindowLong = SetWindowLong(KANJI_Control.hWnd, GWL_WNDPROC, AddressOf GetFurigana)
    
    'ハンドル保存
    Save_hWnd = KANJI_Control.hWnd
    
    'ふりがな文字列初期化
    FURIGANA_STR = ""
    
End Sub

Public Sub Furigana_End()

    'フリガナ監視終了
    
    'イベントのバンドルを解除
    Call SetWindowLong(Save_hWnd, GWL_WNDPROC, Save_WindowLong)
    
End Sub

●以下フォームのコード
Private Sub txtTokField_GotFocus(index As Integer)
    
    Dim himc As Long
    Dim nLEN As Long
    Dim hWnd As Long
    
    If index = 1 Then
            
        hWnd = txtTokField(1).hWnd
        
        'IMEをOn
        himc = ImmGetContext(hWnd)
        Call ImmSetOpenStatus(himc, 1)
        Call ImmReleaseContext(hWnd, himc)
        
        '文字列を反転させる
        txtTokField(1).SelStart = 0
        txtTokField(1).SelLength = Len(txtTokField(1).Text)
        
        'フリガナ監視スタート
        Call Furigana_Start(txtTokField(1))
    
    End If
        
    If index = 2 Then
        
        hWnd = txtTokField(1).hWnd
        
        'IMEをOff
        himc = ImmGetContext(hWnd)
        Call ImmSetOpenStatus(himc, 0)
        Call ImmReleaseContext(hWnd, himc)
            
        'フリガナ監視終了
        Call Furigana_End
            
        '取得したフリガナをセット
        txtTokField(2).Text = txtTokField(2).Text & FURIGANA_STR

    End If
End Sub


●ループしているところは GetFurigana みたいです。みたいですみませ。
一応動きを
@txtTokField(1)へフォーカス移る→Furigana_Start 走る
A画面を広こうとする(止めて走らすとコードが出てきて画面は後ろに行くのでそれを呼び出そうとする)

GetFurigana
BGetFuriganaが3回る
CA〜Bの繰り返し


- 関連一覧ツリー (★ をクリックするとツリー全体を一括表示します)

- 返信フォーム (この記事に返信する場合は下記フォームから投稿して下さい)

- VBレスキュー(花ちゃん) - - Web Forum -