View Full Version : نرم افزار به شکل Active Window یا به شکل Inactive Window
سعید قدیری مقدم
سه شنبه 07 مرداد 1382, 19:29 عصر
سلام دوستان من باز با یک مشکل دیگه مواجه شدم :oops: من میخوام برنامه ای رو که مینویسم بتون تشخیص بده در پنجره Active (کاربر در حال دیدن و کار کردن هست) یا در پنجره Inactive( کاربر با برنامه کار نمیکنه ) قرار داره .
پیشاپیش ممنون :)
S.Azish
سه شنبه 07 مرداد 1382, 20: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, 23:27 عصر
آقا ممنون خیلی خیلی ممنون از راهنماییتون واقعا ممنون هستم :) :) :) :idea:
سعید قدیری مقدم
چهارشنبه 08 مرداد 1382, 01:56 صبح
سلام آقا یک مشکل دیگه :( وقتی داخل فرم برنامه از PictureBox استفاده میکنم چرا DeActivate کار نمیکنه؟ :?:
:( :( :( :(
سعید قدیری مقدم
چهارشنبه 08 مرداد 1382, 12:20 عصر
:?: :?: :?:
:( :( :(
S.Azish
چهارشنبه 08 مرداد 1382, 14: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, 16:31 عصر
ممنون مشکل حل شد :)
vBulletin® v4.2.5, Copyright ©2000-1403, Jelsoft Enterprises Ltd.