home *** CD-ROM | disk | FTP | other *** search
- /*********************************************************************
-
- EX2.PRG - CUA-Clip Library examples.
-
- This file contains sample code illustrating the Event system.
-
- Author: Dave Rooney
- Date : Feb. 22, 1993
-
- *********************************************************************/
-
- #include "Demo.CH"
-
- //
- // Example 2 - Establishing a background procedure using SetInterrupt.
- //
-
- FUNCTION Event_Examples
-
- LOCAL cScreen, ; // Screen behind the dialog box
- cOldColor, ; // Colour on entry
- bInterrupt, ; // Interrupt code block on entry
- nKey, ; // Key pressed by the user
- lExit // Loop control flag
-
- //
- // Initialize the variables...
- //
- cOldColor := SETCOLOR()
- nKey := 0
- lExit := .F.
-
- //
- // Set an interrupt function to be called during wait states,
- // i.e. InterruptKey(). Note that we're saving the current
- // interrupt code block which we'll restore later.
- //
- bInterrupt := SetInterrupt( {|| MyInterrupt() } )
-
- //
- // Display the dialog box:
- //
- // Position Type Colour
- // v v v
- cScreen := ShadowBox( 4, 12, 12, 68, 2, "GR+/B" )
-
- SETCOLOR( "W+/B" )
-
- @ 4,14 SAY "[ CUA-Clip Interface Library - Event System Examples ]"
-
- SETCOLOR( "BG+/B" )
-
- @ 6,14 SAY "Press any key (<ESC> to exit)..."
- @ 8,14 SAY "Scan code:"
- @ 10,14 SAY "Current time:"
-
- SETCOLOR( "W+/B" )
-
- DO WHILE nKey <> K_ESC
- //
- // Read keystrokes until the user presses <ESC>.
- //
- // Note that InterruptKey operates exactly like INKEY (you pass
- // the number of seconds to wait or 0 to wait indefinitely),
- // except that it calls the current Interrupt function in the
- // background.
- //
- nKey := InterruptKey(0)
-
- IF nKey <> K_ESC
- @ 8,25 SAY PADR( STR( nKey, 3 ), 20 )
- ENDIF
- ENDDO
-
- //
- // Get rid of the dialog box...
- //
- KillBox( cScreen )
-
- //
- // Reset the interrupt code block.
- //
- SetInterrupt( bInterrupt )
-
- SETCOLOR( cOldColor )
-
- RETURN NIL
- //
- // That's all folks!
- //
-
-
- /*******************************************************************
-
- FUNCTION MyInterrupt
-
- This is our background function that will be called during the
- InterruptKey wait state. It will display the time in the dialog
- box, and display a message if you wait too long!!
-
- NOTE: You must remember that this function will be called many times!
- As such its processing must be kept to a minimum. In this case
- we will only redisplay the time if it has changed.
-
- Parameters: None.
-
- Returns: NIL
-
- *******************************************************************/
-
- STATIC FUNCTION MyInterrupt
-
- STATIC cOldTime, nWaited
-
- LOCAL cOldColor, ; // Colour on entry
- cCurTime, ; // Current time
- nRow, nCol // Position on entry
-
- IF cOldTime == NIL
- cOldTime := TIME()
- nWaited := 0
- ENDIF
-
- cCurTime := TIME()
-
- IF !( cCurTime == cOldTime )
- cOldColor := SETCOLOR( "W+/B" )
- nRow := ROW()
- nCol := COL()
-
- @ 10,28 SAY cCurTime
-
- cOldTime := cCurTime
-
- IF LastInkey( , TRUE ) == 0
- ++ nWaited
- ELSE
- nWaited := 0
- ENDIF
-
- IF nWaited > 10
- nWaited := 0
-
- TONE( 250, 1 )
-
- @ 8,25 SAY "Well... press a key!"
-
- InterruptKey(3)
-
- @ 8,25 SAY SPACE(20)
- ENDIF
-
- SETPOS( nRow, nCol )
- SETCOLOR( cOldColor )
- ENDIF
-
- RETURN NIL
- //
- // EOP: MyInterrupt
- //
-