'By: Lance(8/11/02 11:06:12 am)
     $TYPECHECK On

     CONST GWL_HWNDPARENT=(-8)
     CONST HWND_DESKTOP=0

     CONST GWL_WNDPROC=(-4)

     CONST WM_ACTIVATE = &H6
     CONST WA_ACTIVE = 1
     CONST WA_INACTIVE = 0

     DECLARE FUNCTION SetWindowLong LIB "User32" ALIAS "SetWindowLongA" (hwnd AS LONG, nIndex AS LONG, dwNewLong AS LONG) AS LONG
     DECLARE FUNCTION CallWindowProc LIB "user32" ALIAS "CallWindowProcA" (lpPrevWndFunc AS LONG, hwnd AS LONG, msg AS LONG, wParam AS LONG, lParam AS LONG) AS LONG

     DECLARE FUNCTION WinProc(hwnd AS LONG, Msg AS LONG, wParam AS LONG, lParam AS LONG) AS LONG
     DIM OldProc AS LONG

     CREATE Form AS QFORM
      Center
     END CREATE

     SetWindowLong(Form.Handle, GWL_HWNDPARENT, HWND_DESKTOP)
     SetWindowLong(Application.Handle, GWL_HWNDPARENT, Form.Handle)

' Set a new window procedure, and save the old one
     OldProc=SetWindowLong(Form.Handle, GWL_WNDPROC, CODEPTR(WinProc))

     Form.ShowModal

' The new window procedure
     FUNCTION WinProc
        ' Check the message
      SELECT CASE Msg
      CASE WM_ACTIVATE
       IF (wParam AND &H0000FFFF)=0 THEN
        Form.Caption="Inactive"
       ELSE
        Form.Caption="Active"
       END IF
      CASE ELSE
                        ' Call the original window procedure
       Result=CallWindowProc(OldProc, Form.Handle, msg, wParam, lParam)
      END SELECT
     END FUNCTION