● クリップボードの変更を監視する ●

クリップボード監視ツールを作るにはこれしかないって処理だけど、サブクラス化する必要がある。

'クリップボード内容変更の通知を取得する
Private Declare Function SetClipboardViewer Lib "user32" (ByVal hWnd As Long) As Long

'クリップボード内容変更通知を解除する
Private Declare Function ChangeClipboardChain Lib "user32" (ByVal hWnd As Long, ByVal hWndNext As Long) As Long

'サブクラス化関数
Private Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long

Private 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

Private Const GWL_WNDPROC = (-4)        'ウインドウプロシージャ 
Private Const WM_DRAWCLIPBOARD = &H308  'クリップボードの内容が変更された時

Private OldWindowhwnd As Long     'デフォルトのウインドウプロシージャ

'---------------------------------------------------------------------------
' 関数名 : SubClass
' 機能   : サブクラス化を開始する
' 引数   : (in) hWnd … 対象フォームのウインドウハンドル
' 返り値 : なし
'---------------------------------------------------------------------------
Public Sub SubClass(ByVal hWnd As Long)

    OldWindowhwnd = SetWindowLong(hWnd, GWL_WNDPROC, AddressOf WindowProc)

End Sub

'---------------------------------------------------------------------------
' 関数名 : UnSubClass
' 機能   : サブクラス化を解除する
' 引数   : (in) hWnd … 対象フォームのウインドウハンドル
' 返り値 : なし
'---------------------------------------------------------------------------
Public Sub UnSubClass(ByVal hWnd As Long)

    If OldWindowhwnd <> 0 Then
    '元のプロシージャアドレスに設定する
        Call SetWindowLong(hWnd, GWL_WNDPROC, OldWindowhwnd)
        OldWindowhwnd = 0
    End If

End Sub

'---------------------------------------------------------------------------
' 関数名: WindowProc
' 機  能: ウインドウメッセージをフックする
' 引  数: (in) hWnd … 対象フォームのウインドウハンドル
'          (in) uMsg … ウインドウメッセージ
'          (in) wParam … 追加情報1
'          (in) lParam … 追加情報2
' 返り値: ウインドウプロシージャアドレス
'---------------------------------------------------------------------------
Public Function WindowProc(ByVal hWnd As Long, ByVal uMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long

    Select Case uMsg
        'クリップボードが変更された
        Case WM_DRAWCLIPBOARD
            Beep
    End Select

    WindowProc = CallWindowProc(OldWindowhwnd, hWnd, uMsg, wParam, lParam)

End Function

今度はフォームモジュールに書いてね。

'クリップボードチェーンの次のウインドウハンドル
Private hWndPrevClip As Long  '<-外部変数だよ

Private Sub Form_Load()

    'クリップボード内容変更通知設定
    hWndPrevClip = SetClipboardViewer(Me.hWnd)

    'サブクラス化開始
    Call SubClass(Me.hWnd)

End Sub

Private Sub Form_Unload(Cancel As Integer)

    'サブクラス化終了
    Call UnSubClass(Me.hWnd)

    'クリップボード内容変更通知解除
    Call ChangeClipboardChain(Me.hWnd, hWndPrevClip)

End Sub

これで終わり。実行中、クリップボードに文字列等が保存されるとビープ音が鳴るから試してみてね。

戻る