投稿日 | : 2002/08/22(Thu) 10:43 |
投稿者 | : ゆう(U) |
Eメール | : |
URL | : |
タイトル | : Re^7: アクティブなテキストボックス |
使用方法が正しいかは自信はありませんが・・・
とりあえず、IDE&EXEで確認は出来ました。
フォームのLoadでSetHookを、UnLoadでUnHookを
必ずCallして下さい。
フォームのキャプションにコントロール名等が
表示されると思います。
※手抜きコードです(On Error Resume Next)
サンプル:標準モジュールへ)
Private Declare Function SetWindowsHookEx Lib "user32" _
Alias "SetWindowsHookExA" _
(ByVal idHook As Long, _
ByVal lpfn As Long, _
ByVal hmod As Long, _
ByVal dwThreadId As Long) As Long
Private Declare Function UnhookWindowsHookEx Lib "user32" _
(ByVal hHook As Long) As Long
Private Declare Function CallNextHookEx Lib "user32" _
(ByVal hHook As Long, _
ByVal nCode As Long, _
ByVal wParam As Long, _
ByVal lParam As Long) As Long
Private Declare Function GetWindowLong Lib "user32" _
Alias "GetWindowLongA" _
(ByVal hWnd As Long, _
ByVal nIndex As Long) As Long
Private Declare Function GetCurrentThreadId Lib "kernel32" () As Long
Private myHookForm As Form
Private hHook As Long
Public Sub SetHook(ByRef myForm As Form)
Const GWL_HINSTANCE = (-6&)
Const WH_CBT = 5&
Dim hInst As Long
Dim lngThread As Long
Set myHookForm = myForm
hInst = GetWindowLong(myHookForm.hWnd, GWL_HINSTANCE)
lngThread = GetCurrentThreadId()
hHook = SetWindowsHookEx(WH_CBT, _
AddressOf WinProc, _
hInst, _
lngThread)
End Sub
Public Sub UnHook()
Call UnhookWindowsHookEx(hHook)
Set myHookForm = Nothing
End Sub
Private Function WinProc(ByVal nCode As Long, _
ByVal wParam As Long, _
ByVal lParam As Long) As Long
Const HCBT_SETFOCUS = 9&
Dim myControl As Control
On Error Resume Next
If nCode = HCBT_SETFOCUS Then
For Each myControl In myHookForm.Controls
If myControl.hWnd = wParam Then
myHookForm.Caption = myControl.Name
myHookForm.Caption = myHookForm.Caption _
& "(" & myControl.Index & ")"
End If
Next
End If
Err.Clear
On Error GoTo 0
'次の処理へ
WinProc = CallNextHookEx(hHook, nCode, wParam, lParam)
End Function