ab.com コミュニティ

'-----------------------------------------------------------------------------
'  イベント プロシージャ
'-----------------------------------------------------------------------------
' このファイルには、ウィンドウ [Dialog1] に関するイベントをコーディングします。
' ウィンドウ ハンドル: hDialog1

' TODO: この位置にグローバルな変数、構造体、定数、関数を定義します。
Dim hHook As Long 'フックハンドル

Const WH_GETMESSAGE = 3 'フックの種類を示す定数
Const HC_ACTION = 0

'フックをインストールする関数の宣言
Declare Function SetWindowsHookEx Lib "user32" _
    Alias "SetWindowsHookExA" _
    (idHook As DWord, _ 'インストールするフックの種類
    lpfn As DWord, _ 'インストールするフック関数のアドレス
    hMod As DWord, _ 'インスタンスハンドル
    dwThreadId As DWord _ 'カレントスレッドID
    ) As DWord '戻り値は、フックハンドル

'フックをアンインストールする関数の宣言
Declare Function UnhookWindowsHookEx Lib "user32" _
       (hHook As DWord) As DWord

'次のフックを呼び出す関数の宣言
Declare Function CallNextHookEx Lib "user32" _
        (hHook As DWord, nCode As Long, _
         wParam As DWord, lParam As DWord) As DWord

'-----------------------------------------------------------------------------
' ウィンドウメッセージを処理するためのコールバック関数

Function Dialog1Proc(hWnd As HWND, dwMsg As DWord, wParam As WPARAM, lParam As LPARAM) As DWord
	' TODO: この位置にウィンドウメッセージを処理するためのコードを記述します。

	' イベントプロシージャの呼び出しを行います。
	Dialog1Proc=EventCall_Dialog1(hWnd,dwMsg,wParam,lParam)
End Function


'-----------------------------------------------------------------------------
' ここから下は、イベントプロシージャを記述するための領域になります。

'
'●デストロイ
'
Sub Dialog1_Destroy()
'Hookのアンインストール(勝手に場所を元のソースから変更したのですが、
ただ、ここでアンインストールしていいのかどうか。。)
    UnhookWindowsHookEx(hHook)

End Sub

'
'●クリエイト
'
Sub Dialog1_Create(ByRef CreateStruct As CREATESTRUCT)

'Hookのインストール
    hHook = SetWindowsHookEx(WH_GETMESSAGE,_
     AddressOf(GetMsgProc),  0,_
     GetWindowThreadProcessId(_
      GetDlgItem(hDialog1,EditBox1),NULL))

    If hHook=0 Then
        MessageBox(hDialog1,"Install Failed", "", MB_OK)
    End If

End Sub

'
'●ボタン1クリック・イベント
'
Sub Dialog1_CommandButton1_Click()
  MessageBox(hDialog1,"Dialog1_CommandButton1_Click","Message",MB_OK)

End Sub

'
'●エディットボックスのメッセージ取得
'
Function GetMsgProc(code As Long, wParam As DWord, lParam As DWord) As DWord
    Dim msg As *MSG

    If code = HC_ACTION Then
        'lParamは、メッセージが格納されているメモリ領域の _
        'アドレスを示すポインタなので、 _
        'そのままMSG構造体ポインタにコピーする
        msg=lParam

        If msg->message = WM_KEYDOWN And_
           msg->wParam = VK_RETURN Then

         'EnterならフォーカスをCommandButton1に単に投げているだけ。テスト処理。
          Print "VK_RETURN"
          SetFocus(GetDlgItem(hDialog1,CommandButton1))

        End If

    End If
    '次のフックを呼び出す
    GetMsgProc = CallNextHookEx(hHook,code,wParam,lParam)
End Function

TypeDef WNDPROC = *Function(ByVal hwnd As HWND,ByVal msg As DWord,ByVal wParam As WPARAM,ByVal lParam As LPARAM) As LRESULT

Dim hEdit As HWND
Dim OldEditProc As WNDPROC

Sub Dialog1_Create(ByRef CreateStruct As CREATESTRUCT)
	hEdit=GetDlgItem(hDialog1,EditBox1)
	OldEditProc=SetWindowLong(hEdit,GWL_WNDPROC,AddressOf(EditBoxProc)) As WNDPROC
End Sub

Sub Dialog1_Destroy()
	SetWindowLong(hEdit,GWL_WNDPROC,OldEditProc)
End Sub

Function EditBoxProc(ByVal hWnd As HWND,ByVal dwMsg As DWord,ByVal wParam As WPARAM,ByVal lParam As LPARAM) As LRESULT
	Select Case dwMsg
		Case WM_KEYDOWN
			' エンターキーが押された時
			If wParam=13 Then
				SetFocus(GetDlgItem(hDialog1,CommandButton1))
			End If
	End Select

	EditBoxProc=CallWindowProc(OldEditProc,hWnd,dwMsg,wParam,lParam)
End Function

'---------------------------
'  Window Message Loop
'---------------------------
Dim msgMain As MSG, iResult As Long
Do
	iResult=GetMessage(msgMain,0,0,0)
	If iResult=0 or iResult=-1 Then Exit Do

    If IsDialogMessage(hMainWnd, msgMain) Then Continue

	TranslateMessage(msgMain)
	DispatchMessage(msgMain)
Loop

' Call destructores and exit process
End