PDA

View Full Version : نرم افزار به شکل Active Window یا به شکل Inactive Window



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

S.Azish
سه شنبه 07 مرداد 1382, 19:44 عصر
دوست عزیز, با 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

سعید قدیری مقدم
سه شنبه 07 مرداد 1382, 22:27 عصر
آقا ممنون خیلی خیلی ممنون از راهنماییتون واقعا ممنون هستم :) :) :) :idea:

سعید قدیری مقدم
چهارشنبه 08 مرداد 1382, 00:56 صبح
سلام آقا یک مشکل دیگه :( وقتی داخل فرم برنامه از PictureBox استفاده میکنم چرا DeActivate کار نمیکنه؟ :?:
:( :( :( :(

سعید قدیری مقدم
چهارشنبه 08 مرداد 1382, 11:20 صبح
:?: :?: :?:
:( :( :(

S.Azish
چهارشنبه 08 مرداد 1382, 13:02 عصر
ببخشید دوست عزیز, یک 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

سعید قدیری مقدم
چهارشنبه 08 مرداد 1382, 15:31 عصر
ممنون مشکل حل شد :)