SAK 図書館

SAK Streets メインストリート 図書館・カフェ 一覧 SAK Streets 検索
| VB | SQL | Perl | PHP | ASP | JSP | C | PC | HP | FAQ | フリーソフト |

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 ビジュアル編資料
| VB | SQL | Perl | PHP | ASP | JSP | C | PC | HP | FAQ | フリーソフト |

SAK Streets メインストリート 図書館・カフェ 一覧 SAK Streets 検索



Copyright (C) 1999-2017 Y.SAK