SAK 図書館
SAK 図書館
VB テクニック編31 - サブクラスコントロール、フックプロシジャ、メッセージ処理
■SAK 関数利用規程
・テクニック編で紹介する関数は、私こと Y.SAK の開発関数である。
・著作権明示部分の改編は認めない。
・個人、企業がこれらの関数を使用したり、一部を使用して新たなシステムや
プログラムを開発することは自由です。
・但し、これらの関数を一部でも使用しているソフトウェアをシェアウェア、
その他有償プロダクトとして配布・販売するには、私の許可が必要です。
(無償のフリーソフトウェアなら、自由に配布しても良い。)
・これらの関数を使用して発生した、いかなる形での損害も私こと Y.SAK は
賠償しません。
■ウィンドウプロシジャのサブクラスコントロール
・C 言語では、通常ウィンドウプロシジャで、メッセージイベント処理を行う。
しかし、VB では、サブクラス、フックと言う手法を使わない限り、ウィン
ドウプロシジャを直接コードするようなことは出来ない。
C 言語による WndProc は次のような感じである。
LRESULT CALLBACK _export WndProc(HWND hWnd, UINT message, WPARAM wParam, LPARAM lParam)
{
// メッセージ処理
switch (message) {
// ドラッグ and ドロップ
case WM_DROPFILES:
...
// ウィンドウ作成
case WM_CREATE:
...
// サイズ固定
case WM_GETMINMAXINFO:
...
// サイズ変更
case WM_SIZE:
...
// ウィンドウ移動
case WM_MOVE:
...
// アクティブ
case WM_ACTIVATE:
...
// パレット変更
case WM_PALETTECHANGED:
...
// フォーカス
case WM_SETFOCUS:
...
// 再画像
case WM_PAINT:
...
// タイマー
case WM_TIMER:
...
// メニュー選択
case WM_COMMAND:
...
// コントロールメニュー選択
case WM_SYSCOMMAND:
...
// アイコンオープン
case WM_QUERYOPEN:
...
// ウィンドウクローズ
case WM_CLOSE:
...
// ウィンドウ廃棄
case WM_DESTROY:
...
}
// デフォルトメッセージ処理
return(DefWindowProc(hWnd, message, wParam, lParam));
}
・VB で、ウィンドウメッセージ処理を記述するには、例えば、サブクラスで
割り込みます。
サブクラスの場合、デフォルトメッセージ処理は、DefWindowProc には
なりません。CallWindowProc で、他にもサブクラスしているかもしれない
プロシジャを呼び出します。
WndProc は、必ず、コードモジュール(.bas) に配置して下さい。
・VB では、自分に対するサブクラス化やフックプロシジャのインストールは
出来るが、他プログラムに対しては、うまく動かないようです。
C 言語であれば、DLL レベルにすれば、まったく問題ありません。
VB でも DLL にすれば、できるかもしれません。
public OldWndProc as long
public const GWL_WNDPROC = -4
public const WM_SIZE = 5
public const WM_MOVE = 3
public function WndProc(ByVal hwindow as long, ByVal message as long, ByVal wParam as long, ByVal lParam as long) as long
'** メッセージ処理
select case message
case WM_SIZE
...
case WM_MOVE
...
end select
'** デフォルトメッセージ処理
WndProc = CallWindowProc(OldWndProc, hwindow, message, wParam, lParam)
end function
・サブクラスコントロールの開始は次のようにします。
一般的にサブクラスコントロール開始は、Form_Load などで最初に一度だけ
行います。(VB の予約語 HWND は、フォームのウィンドウハンドルです。)
'** サブクラスコントロール開始
OldWndProc = GetWindowLong(HWND, GWL_WNDPROC)
SetWindowLong HWND, GWL_WNDPROC, AddressOf WndProc
・サブクラスコントロールの終了は次のようにします。
一般的にサブクラスコントロール終了は、Form_Unload などで最後に一度だ
け行います。
'** サブクラスコントロール終了
SetWindowLong HWND, GWL_WNDPROC, OldWndProc
・サブクラスコントロール以外に Hook 関数を使用したメッセージフックでも
メッセージ処理できるかもしれません。少しパラメタや使用関数は違います
が、基本的な考え方は似ています。
Private Declare Function GetWindowLongA Lib "user32" (ByVal hwd As Long, ByVal nIndex As Long) As Long
Private Declare Function GetWindowLongW Lib "user32" (ByVal hwd As Long, ByVal nIndex As Long) As Long
Private Declare Function SetWindowLongA Lib "user32" (ByVal hwd As Long, ByVal nIndex As Long, ByVal dt As Long) As Long
Private Declare Function SetWindowLongW Lib "user32" (ByVal hwd As Long, ByVal nIndex As Long, ByVal dt As Long) As Long
Private Declare Function CallWindowProcA Lib "user32" (ByVal oldproc As Long, ByVal hwd As Long, ByVal msg as long, ByVal wParam as long, ByVal lParam as long) as long
Private Declare Function CallWindowProcW Lib "user32" (ByVal oldproc As Long, ByVal hwd As Long, ByVal msg as long, ByVal wParam as long, ByVal lParam as long) as long
'=======================================================================
' Windows API GetWindowLong()
'=======================================================================
Public Function GetWindowLong(hwd As Long, nIndex As Long) As Long
If GetOS() = VER_PLATFORM_WIN32_NT Then
GetWindowLong = GetWindowLongW(hwd, nIndex)
Else
GetWindowLong = GetWindowLongA(hwd, nIndex)
End If
End Function
'=======================================================================
' Windows API SetWindowLong()
'=======================================================================
Public Function SetWindowLong(hwd As Long, nIndex As Long, dt As Long) As Long
If GetOS() = VER_PLATFORM_WIN32_NT Then
SetWindowLong = SetWindowLongW(hwd, nIndex, dt)
Else
SetWindowLong = SetWindowLongA(hwd, nIndex, dt)
End If
End Function
'=======================================================================
' Windows API CallWindowProc()
'=======================================================================
Public Function CallWindowProc(oldproc As Long, hwd As Long, msg as long, wParam as long, lParam as long) as long
If GetOS() = VER_PLATFORM_WIN32_NT Then
CallWindowProc = CallWindowProcW(oldproc, hwd, msg, wParam, lParam)
Else
CallWindowProc = CallWindowProcA(oldproc, hwd, msg, wParam, lParam)
End If
End Function
■フックプロシジャ
・フックプロシジャをインストールすることで、メッセージ処理を行うことも
出来る。VB では、サブクラス同様にシステム全体にフックするような事は
できない。(DLL にすれば可能かもしれない。)
・以下のサンプルは正常に動作しない。(^^;
どこかにミスがあるか、VB ではフックが使えないかのどちらかである。
(以前にテストしたときは、動かせたと思うのだが...)
また、動作テストができなかったので、HOOKLPARAM 構造体が逆順かもしれ
ない。(しおしお)
Type HOOKLPARAM
lParam As Long
wParam As Long
uMsg As Long
hWnd As Long
End Type
public hInstance as long
public ThreadId as long
public hHook as long
public const GWL_HINSTANCE = -6
public const WH_CALLWNDPROC = 4
public const WM_SIZE = 5
public const WM_MOVE = 3
public function CallWndProc(ByVal ncode as long, ByVal wParam as long, lParam as HOOKLPARAM) as long
'** メッセージ処理
if ncode >= 0 then
select case lParam.hWnd
case WM_SIZE
...
case WM_MOVE
...
end select
end if
'** デフォルトメッセージ処理
CallWndProc = CallNextHookEx(hHook, ncode, wParam, lParam)
end function
・フックの開始は次のようにします。
一般的にフック開始は、Form_Load などで最初に一度だけ行います。
(VB の予約語 HWND は、フォームのウィンドウハンドルです。)
'** フック開始
hInstance = GetWindowLong(HWND, GWL_HINSTANCE)
ThreadId = GetCurrentThreadId()
hHook = SetWindowsHookEx(WH_CALLWNDPROC, AddressOf CallWndProc, hInstance, ThreadId)
・フックの終了は次のようにします。
一般的にフック終了は、Form_Unload などで最後に一度だけ行います。
'** フック終了
UnhookWindowsHookEx hHook
・以下は、関連 API である。
Private Declare Function SetWindowsHookExA Lib "user32" (ByVal idhook As Long, ByVal hookproc As Long, ByVal hinstance as long, ByVal htask as long) as long
Private Declare Function SetWindowsHookExW Lib "user32" (ByVal idhook As Long, ByVal hookproc As Long, ByVal hinstance as long, ByVal htask as long) as long
Private Declare Function UnhookWindowsHookExA Lib "user32" (ByVal hhook As Long) as long
Private Declare Function UnhookWindowsHookExW Lib "user32" (ByVal hhook As Long) as long
Private Declare Function CallNextHookExA Lib "user32" (ByVal hhook As Long, ByVal ncode As Long, ByVal wPrame As Long, lParam As HOOKLPARAM) as long
Private Declare Function CallNextHookExW Lib "user32" (ByVal hhook As Long, ByVal ncode As Long, ByVal wPrame As Long, lParam As HOOKLPARAM) as long
Public Declare Function GetCurrentThreadId Lib "kernel32" () as long
'=======================================================================
' Windows API SetWindowsHookEx()
'=======================================================================
Public Function SetWindowsHookEx(idhook As Long, hookproc As Long, hinstance as long, htask as long) as long
If GetOS() = VER_PLATFORM_WIN32_NT Then
SetWindowsHookEx = SetWindowsHookExW(idhook, hookproc, hinstance, htask)
Else
SetWindowsHookEx = SetWindowsHookExA(idhook, hookproc, hinstance, htask)
End If
End Function
'=======================================================================
' Windows API UnhookWindowsHookEx()
'=======================================================================
Public Function UnhookWindowsHookEx(hhook As Long) as long
If GetOS() = VER_PLATFORM_WIN32_NT Then
UnhookWindowsHookEx = UnhookWindowsHookExW(hhook)
Else
UnhookWindowsHookEx = UnhookWindowsHookExA(hhook)
End If
End Function
'=======================================================================
' Windows API CallNextHookEx()
'=======================================================================
Public Function CallNextHookEx(hhook As Long, ncode As Long, wPrame As Long, lParam As HOOKLPARAM) as long
If GetOS() = VER_PLATFORM_WIN32_NT Then
CallNextHookEx = CallNextHookExW(hhook, ncode, wPrame, lParam)
Else
CallNextHookEx = CallNextHookExA(hhook, ncode, wPrame, lParam)
End If
End Function
■VB テクニック編資料
■VB 入門編資料
■VB 基礎編資料
■VB ビジュアル編資料
Copyright (C) 1999-2018 Y.SAK