● アクティブ・非アクティブを取得する ●

サクラエディタを見ると、タイトルバーにアクティブ時は編集中ファイルのフルパスを、非アクティブ時はファイル名を表示している。このようなことをするときに使えるテクニックである。

'デフォルトのウィンドウ・プロシージャを呼ぶ
Public 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

'ウィンドウの属性を設定する
Public Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long

Private Const GWL_WNDPROC As Long = (-4)
Private Const WM_ACTIVATE = &H6
Private Const WM_ACTIVATEAPP = &H1C
Private Const WA_INACTIVE = 0
Private Const WA_ACTIVE = 1
Private Const WA_CLICKACTIVE = 2

Public OldWindowhWnd As Long

'-----------------------------------------------------------------------
' 関数名 : SubClass
' 機能   : サブクラス化を開始する
' 引数   : (in) hWnd  … コールバック対象となるウインドウのハンドル
' 戻り値 : なし
'-----------------------------------------------------------------------
Public Function SubClass(ByVal hWnd As Long) As Long
    OldWindowhWnd = SetWindowLong(hWnd, GWL_WNDPROC, AddressOf WindowProc)
    SubClass = OldWindowhWnd
End Function


'-----------------------------------------------------------------------
' 関数名 : UnSubClass
' 機能   : サブクラス化を終了する
' 引数   : (in) hWnd  … コールバック対象となるウインドウのハンドル
' 戻り値 : なし
'-----------------------------------------------------------------------
Public Sub UnSubClass(ByVal hWnd As Long)
    Dim FuncRet As Long

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


'-----------------------------------------------------------------------
' 関数名:WindowProc
' 機  能:いわずとしれたウインドウプロシージャ
'-----------------------------------------------------------------------
Private 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_ACTIVATEAPP
            Select Case wParam
                '他のウインドウがアクティブになった
                Case WA_INACTIVE
                    Debug.Print "非アクティブです"
                'アクティブになった
                Case WA_ACTIVE
                    Debug.Print "アクティブです"
        End Select
    End Select

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

End Function

あとは、Form_Load() イベントあたりから呼ぶだけ。コールバックを解除するのも忘れずに。

Private Sub Form_Load()

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

End Sub

Private Sub Form_Unload(Cancel As Integer)

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

End Sub

戻る