【VB6・VBAメモ】WindowsAPI:CallWindowProc関数

CallWindowProc関数は指定したウィンドウプロシージャにメッセージを渡します。
ウィンドウのサブクラス化を実装した場合に、
サブクラス化での処理とは別に、元のウィンドウプロシージャの処理を実行したいときに使います。
(むしろサブクラス化した場合は使わないと危険)

なお、ウィドウのサブクラス化とは、
通常のウィンドウプロシージャから一部の処理を別関数に切り離して(横取りして)処理をさせることを言います。

サブクラス化を実装することにより、
通常VBでは検知できないタイトルバーの操作やマウスホイール等のイベントを検知して処理することができるようになります。
(各メッセージを理解しておく必要がありますが)

サブクラス化は画面やコントロール等、ウィンドウハンドルが取得できるものであれば行うことができます。
ウィンドウハンドルはhWndプロパティから取得できるようです。

C++以外で使う場合は後始末の処理を忘れないようにしてください。(ウィンドウズごとフリーズする恐れがあります)
※サンプルコードの使用は自己責任でお願いしいます。

概要
LRESULT CallWindowProc(WNDPROC lpPrevWndFunc, HWND hWnd, UINT Msg, WPARAM wParam, LPARAM lParam)
機能 指定されたウィンドウプロシージャに、メッセージ情報を渡す
引数 lpPrevWndFunc 対象となるウィンドウプロシージャ WNDPROC
hWnd 対象となるウィンドウのハンドル HWND
(unsigned long)
Msg メッセージ UINT
(unsigned int)
wParam メッセージの最初のパラメータ WPARAM
(unsigned int)
lParam メッセージの2番目のパラメータ LPARAM
(long)
戻り値 メッセージ処理の結果 LRESULT
(long)
使用例(1):サブクラス化(タイトルバーのマウス操作検知)

非クライアント領域(タイトルバーなど)のマウス操作の検知する処理のサンプルコードです。

サブクラス化したウィンドウプロシージャの最後のCallWindowProc関数を
忘れると危険なので注意してください。
これを忘れると必要なメッセージの処理が実行されずにフリーズしたり落ちたりします。
また、サブクラス化の解除の終了処理を忘れるのも危険なので注意してください。

'FrmSample1.frm'

Option Explicit

'画面起動時処理'
Private Sub Form_Load()
    'サブクラス化を設定'
    Call SetSubProc1(Me.hWnd)
End Sub

'画面終了時処理'
Private Sub Form_Unload(Cancel As Integer)
    'サブクラス化を解除(これを忘れると危険)'
    Call UnSetSubProc1(Me.hWnd)
End Sub
'SubClassSample1.bas'

Option Explicit

'API宣言'
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
Declare Function SetWindowLong Lib "user32" _
          Alias "SetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long, _
                                  ByVal dwNewLong As Long) As Long
                                  
'APIメッセージ定義'
Const WM_NCLBUTTONDOWN   As Long = &HA1 '非クライアント領域でマウスクリック(左)'
Const WM_NCLBUTTONDBLCLK As Long = &HA3 '非クライアント領域でダブルクリック(左)'
Const WM_NCRBUTTONDOWN   As Long = &HA4 '非クライアント領域でマウスクリック(右)'
Const WM_NCRBUTTONDBLCLK As Long = &HA6 '非クライアント領域でダブルクリック(右)'
Const WM_NCMBUTTONDOWN   As Long = &HA7 '非クライアント領域でマウスクリック(中)'
Const WM_NCMBUTTONDBLCLK As Long = &HA9 '非クライアント領域でダブルクリック(中)'

'API定数定義'
Const GWL_WNDPROC    As Long = (-4)   'ウィンドウプロシージャ書換'
 
'変数定義'
Private prOrgProc As Long   '元のウィンドウプロシージャのアドレス'

'サブクラス化を設定'
Public Sub SetSubProc1(ByVal hWnd As Long)
    'サブクラス化用のウィンドウプロシージャを設定'
    prOrgProc = SetWindowLong(hWnd, GWL_WNDPROC, AddressOf SubProc)
End Sub

'サブクラス化を解除'
Public Sub UnSetSubProc1(ByVal hWnd As Long)
    '元のウィンドウプロシージャに戻す'
    Call SetWindowLong(hWnd, GWL_WNDPROC, prOrgProc)
End Sub

'サブクラス化したウィンドウプロシージャ'
Private Function SubProc(ByVal hWnd As Long, ByVal msg As Long, _
                         ByVal wp As Long, ByVal lp As Long) As Long
On Error GoTo ERR_HANDLER
    Select Case msg
    Case WM_NCLBUTTONDOWN
        Debug.Print "左マウスクリック"
    Case WM_NCLBUTTONDBLCLK
        Debug.Print "左ダブルクリック"
        
    Case WM_NCRBUTTONDOWN
        Debug.Print "右マウスクリック"
        
        '右マウスクリックは元のメッセージの処理は行わない'
        '※右ダブルクリックを検知させるため、右クリックメニューを表示させない'
        Exit Function
    Case WM_NCRBUTTONDBLCLK
        Debug.Print "右ダブルクリック"
        
    Case WM_NCMBUTTONDOWN
        Debug.Print "中マウスクリック"
    Case WM_NCMBUTTONDBLCLK
        Debug.Print "中ダブルクリック"
    End Select
ERR_HANDLER:
    '元のメッセージを処理を実行(これを忘れると危険)'
    SubProc = CallWindowProc(prOrgProc, hWnd, msg, wp, lp)
End Function


【タイトルバーで左クリック】
左マウスクリック

【タイトルバーで左ダブルクリック】
左マウスクリック
左ダブルクリック

【タイトルバーで右クリック】
右マウスクリック

【タイトルバーで右ダブルクリック】
右マウスクリック
右ダブルクリック

【タイトルバーで右クリック】
中マウスクリック

【タイトルバーで中ダブルクリック】
中マウスクリック
中ダブルクリック
使用例(2):サブクラス化(右クリックメニュー無効化・マウスホイール検知)

複数コントロールを同時にサブクラス化したサンプルコードです。
テキストボックスの右クリックメニューの無効化と、
ボタン上でのマウスホイールの検知を行っています。
(ボタン上で検知してどうするといった感じですが、こんなこともできるということで)

使用例(1)と同様、
サブクラス化したそれぞれのウィンドウプロシージャの最後のCallWindowProc関数を
忘れると危険なので注意してください。
また、サブクラス化の解除の終了処理を忘れるのも危険なので注意してください。

'FrmSample2.frm'

Option Explicit

'画面起動時処理'
Private Sub Form_Load()
    'サブクラス化を設定'
    Call SetSubProc2(Me.TxtSample.hWnd, Me.BtnSample.hWnd)
End Sub

'画面終了時処理'
Private Sub Form_Unload(Cancel As Integer)
    'サブクラス化を解除(これを忘れると危険)'
    Call UnSetSubProc2(Me.TxtSample.hWnd, Me.BtnSample.hWnd)
End Sub
'SubClassSample2.bas'

Option Explicit

'API宣言'
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
Declare Function SetWindowLong Lib "user32" _
          Alias "SetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long, _
                                  ByVal dwNewLong As Long) As Long
                                            
'APIメッセージ定義'
Const WM_CONTEXTMENU As Long = &H7B   'コンテキストメニュー(右クリックメニュー)'
Const WM_MOUSEWHEEL  As Long = &H20A  'マウスホイール'
 
'API定数定義'
Const GWL_WNDPROC    As Long = (-4)   'ウィンドウプロシージャ書換'
 
'変数定義'
Private prOrgProcTxt As Long   '元のウィンドウプロシージャのアドレス'
Private prOrgProcBtn As Long   '元のウィンドウプロシージャのアドレス'
 
'サブクラス化を設定'
Public Sub SetSubProc2(ByVal hWndTxt As Long, ByVal hWndBtn As Long)
    'TxtSampleのサブクラス化を設定'
    prOrgProcTxt = SetWindowLong(hWndTxt, GWL_WNDPROC, AddressOf SubProc_Txt)
    
    'BtnSampleのサブクラス化を設定'
    prOrgProcBtn = SetWindowLong(hWndBtn, GWL_WNDPROC, AddressOf SubProc_Btn)
End Sub
 
'サブクラス化を解除'
Public Sub UnSetSubProc2(ByVal hWndTxt As Long, ByVal hWndBtn As Long)
    'TxtSampleのサブクラス化を解除(元のウィンドウプロシージャに戻す)'
    Call SetWindowLong(hWndTxt, GWL_WNDPROC, prOrgProcTxt)
    
    'BtnSampleのサブクラス化を解除(元のウィンドウプロシージャに戻す)'
    Call SetWindowLong(hWndBtn, GWL_WNDPROC, prOrgProcBtn)
End Sub
 
'TxtSample用にサブクラス化したウィンドウプロシージャ'
Private Function SubProc_Txt(ByVal hWnd As Long, ByVal msg As Long, _
                             ByVal wp As Long, ByVal lp As Long) As Long
On Error GoTo ERR_HANDLER
    Select Case msg
    Case WM_CONTEXTMENU
        'コンテキストメニューを表示しない'
        Debug.Print "Txt:右クリックメニュー無効化"
        Exit Function
    End Select
ERR_HANDLER:
    '元のメッセージを処理を実行(これを忘れると危険)'
    SubProc_Txt = CallWindowProc(prOrgProcTxt, hWnd, msg, wp, lp)
End Function
 
'BtnSample用にサブクラス化したウィンドウプロシージャ'
Private Function SubProc_Btn(ByVal hWnd As Long, ByVal msg As Long, _
                             ByVal wp As Long, ByVal lp As Long) As Long
On Error GoTo ERR_HANDLER
    Select Case msg
    Case WM_MOUSEWHEEL
        Debug.Print "Btn:マウスホイール"
    End Select
ERR_HANDLER:
    '元のメッセージを処理を実行(これを忘れると危険)'
    SubProc_Btn = CallWindowProc(prOrgProcBtn, hWnd, msg, wp, lp)
End Function


【TxtSapmleで右クリック】
Txt:右クリックメニュー無効化

【BtnSample上でマウスホイール】
Btn:マウスホイール
(ボタンにフォーカスがある場合のみ)


コメント
コメントする








    
この記事のトラックバックURL
トラックバック