侦测离开Form进入其他程序
来源:cww

虽然Form有Activate与DeActivate的Events,但是这两个Events只对form的Focus是在
同一个Process不同Form之间的切换有效,如果我们在Form1,而Click其他的Process,
则Form1并不会产生DeActivate的Events,相同的,由其他的Process 回到Form1时,也
不会产生Activate的Events。唯一能得知的便是透过WM_ACTIVATE,其LowWord of wParam
有以下三个值:
  WA_ACTIVE       Activated by some method other than a mouse click 
  WA_CLICKACTIVE  Activated by a mouse click.
  WA_INACTIVE     Deactivated
透过Subclassing的技巧便可来解决这个问题

'以下在.bas
Option Explicit

Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" _
  (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" _
  (ByVal hwnd As Long, ByVal nIndex As Long) As Long
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 Const GWL_WNDPROC = (-4)
 Public Const WM_ACTIVATE = &H6
 Public Const WA_ACTIVE = 1
 Public Const WA_CLICKACTIVE = 2
 Public Const WA_INACTIVE = 0


 Public preWinProc As Long

 Public Function wndproc(ByVal hwnd As Long, ByVal Msg As Long, _
                         ByVal wParam As Long, ByVal lParam As Long) As Long
 Dim fActive As Integer
 If Msg = WM_ACTIVATE Then
    '取得wParam的LowWord
    fActive = CInt(wParam And &HFFFF)
    If fActive = WA_INACTIVE Then
       Debug.Print "InActive "
    Else
       Debug.Print "Active"
    End If
 End If
 '将之送往原来的Window Procedure
 wndproc = CallWindowProc(preWinProc, hwnd, Msg, wParam, lParam)
 End Function
'以下在form
 Option Explicit
 Private Sub Form_Activate()
 Debug.Print "Event Activate"
 End Sub

 Private Sub Form_Deactivate()
 Debug.Print "Event DeActivate"
 End Sub

 Private Sub Form_Load()
 Dim ret As Long
 '记录原本的Window Procedure的位址
 preWinProc = GetWindowLong(Me.hwnd, GWL_WNDPROC)
 '设定Combo1的window Procedure到wndproc
 ret = SetWindowLong(Me.hwnd, GWL_WNDPROC, AddressOf wndproc)
 End Sub

 Private Sub Form_Unload(Cancel As Integer)
 Dim ret As Long
 '取消Message的截取,而使之又只送往原来的Window Procedure
 ret = SetWindowLong(Me.hwnd, GWL_WNDPROC, preWinProc)
 End Sub