نرم افزار به شکل Active Window یا به شکل Inactive Window

[سعید قدیری مقدم]

سلام دوستان من باز با یک مشکل دیگه مواجه شدم :oops: من میخوام برنامه ای رو که مینویسم بتون تشخیص بده در پنجره Active (کاربر در حال دیدن و کار کردن هست) یا در پنجره Inactive( کاربر با برنامه کار نمیکنه ) قرار داره .
پیشاپیش ممنون :)

[S.Azish]

دوست عزیز, با Subclassing میشه اینکارو انجام داد

' in a form

Option Explicit



Public Sub Activate()

    Print "Activated"

End Sub



Public Sub DeActivate()

    Print "Deactivated"

End Sub



Private Sub Form_Load()

    gHW = Me.hWnd

    Hook

End Sub



Private Sub Form_Unload(Cancel As Integer)

    UnHook

End Sub







' in a module

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 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 = -4

Private Const WM_ACTIVATEAPP = &H8

Private Const WM_DEACTIVATEAPP = &H105A



Private lpPrevWndProc As Long

Global gHW As Long



Public Sub Hook()

    lpPrevWndProc = SetWindowLong(gHW, GWL_WNDPROC, _

                                 AddressOf WindowProc)

End Sub



Public Sub UnHook()

    Dim lngReturnValue As Long

    lngReturnValue = SetWindowLong(gHW, GWL_WNDPROC, lpPrevWndProc)

End Sub



Function WindowProc(ByVal hw As Long, _

                    ByVal uMsg As Long, _

                    ByVal wParam As Long, _

                    ByVal lParam As Long) As Long



    Select Case uMsg

        Case WM_ACTIVATEAPP

            Call Form1.DeActivate

        Case WM_DEACTIVATEAPP

            Call Form1.Activate

        Case Else

            WindowProc = CallWindowProc(lpPrevWndProc, hw, _

                                       uMsg, wParam, lParam)

    End Select

    

End Function

[سعید قدیری مقدم]

آقا ممنون خیلی خیلی ممنون از راهنماییتون واقعا ممنون هستم :) :) :) :idea:

[سعید قدیری مقدم]

سلام آقا یک مشکل دیگه :( وقتی داخل فرم برنامه از PictureBox استفاده میکنم چرا DeActivate کار نمیکنه؟ :?:
:( :( :( :(

[سعید قدیری مقدم]

:?: :?: :?:
:( :( :(

[S.Azish]

ببخشید دوست عزیز, یک bug کوچیک بود.

' in module

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 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 = -4

Private Const WM_ACTIVATEAPP = &H105A

Private Const WM_DEACTIVATEAPP = &H86



Private lpPrevWndProc As Long

Global gHW As Long



Public Sub Hook()

    lpPrevWndProc = SetWindowLong(gHW, GWL_WNDPROC, _

                                 AddressOf WindowProc)

End Sub



Public Sub UnHook()

    Dim lngReturnValue As Long

    lngReturnValue = SetWindowLong(gHW, GWL_WNDPROC, lpPrevWndProc)

End Sub



Function WindowProc(ByVal hw As Long, _

                    ByVal uMsg As Long, _

                    ByVal wParam As Long, _

                    ByVal lParam As Long) As Long



    Select Case uMsg

        Case WM_ACTIVATEAPP

            Call Form1.Activate

        Case 134

            If wParam = 0 Then

                Call Form1.DeActivate

            End If

        Case Else

    End Select

    WindowProc = CallWindowProc(lpPrevWndProc, hw, _

                               uMsg, wParam, lParam)

    

End Function

[سعید قدیری مقدم]

ممنون مشکل حل شد :)