home *** CD-ROM | disk | FTP | other *** search
/ Monster Media 1993 #2 / Image.iso / clipper / cuaclip.zip / EX2.PRG < prev    next >
Text File  |  1993-06-01  |  3KB  |  161 lines
  1. /*********************************************************************
  2.  
  3.     EX2.PRG - CUA-Clip Library examples.
  4.  
  5.     This file contains sample code illustrating the Event system.
  6.  
  7. Author: Dave Rooney
  8. Date  : Feb. 22, 1993
  9.  
  10. *********************************************************************/
  11.  
  12. #include "Demo.CH"
  13.  
  14. //
  15. // Example 2 - Establishing a background procedure using SetInterrupt.
  16. //
  17.  
  18. FUNCTION Event_Examples
  19.  
  20. LOCAL cScreen,       ; // Screen behind the dialog box
  21.         cOldColor,     ; // Colour on entry
  22.         bInterrupt,    ; // Interrupt code block on entry
  23.         nKey,          ; // Key pressed by the user
  24.         lExit            // Loop control flag
  25.  
  26. //
  27. // Initialize the variables...
  28. //
  29. cOldColor := SETCOLOR()
  30. nKey      := 0
  31. lExit     := .F.
  32.  
  33. //
  34. // Set an interrupt function to be called during wait states,
  35. // i.e. InterruptKey().  Note that we're saving the current
  36. // interrupt code block which we'll restore later.
  37. //
  38. bInterrupt := SetInterrupt( {|| MyInterrupt() } )
  39.  
  40. //
  41. // Display the dialog box:
  42. //
  43. //                      Position   Type Colour
  44. //                         v         v     v
  45. cScreen := ShadowBox( 4, 12, 12, 68, 2, "GR+/B" )
  46.  
  47. SETCOLOR( "W+/B" )
  48.  
  49. @ 4,14 SAY "[ CUA-Clip Interface Library - Event System Examples ]"
  50.  
  51. SETCOLOR( "BG+/B" )
  52.  
  53. @  6,14 SAY "Press any key (<ESC> to exit)..."
  54. @  8,14 SAY "Scan code:"
  55. @ 10,14 SAY "Current time:"
  56.  
  57. SETCOLOR( "W+/B" )
  58.  
  59. DO WHILE nKey <> K_ESC
  60.     //
  61.     // Read keystrokes until the user presses <ESC>.
  62.     //
  63.     // Note that InterruptKey operates exactly like INKEY (you pass
  64.     // the number of seconds to wait or 0 to wait indefinitely),
  65.     // except that it calls the current Interrupt function in the
  66.     // background.
  67.     //
  68.     nKey := InterruptKey(0)
  69.  
  70.     IF nKey <> K_ESC
  71.         @ 8,25 SAY PADR( STR( nKey, 3 ), 20 )
  72.     ENDIF
  73. ENDDO
  74.  
  75. //
  76. // Get rid of the dialog box...
  77. //
  78. KillBox( cScreen )
  79.  
  80. //
  81. // Reset the interrupt code block.
  82. //
  83. SetInterrupt( bInterrupt )
  84.  
  85. SETCOLOR( cOldColor )
  86.  
  87. RETURN NIL
  88. //
  89. // That's all folks!
  90. //
  91.  
  92.  
  93. /*******************************************************************
  94.  
  95.     FUNCTION MyInterrupt
  96.  
  97.     This is our background function that will be called during the
  98. InterruptKey wait state.  It will display the time in the dialog
  99. box, and display a message if you wait too long!!
  100.  
  101. NOTE: You must remember that this function will be called many times!
  102.         As such its processing must be kept to a minimum.  In this case
  103.         we will only redisplay the time if it has changed.
  104.  
  105.     Parameters: None.
  106.  
  107.         Returns: NIL
  108.  
  109. *******************************************************************/
  110.  
  111. STATIC FUNCTION MyInterrupt
  112.  
  113. STATIC cOldTime, nWaited
  114.  
  115. LOCAL cOldColor,     ; // Colour on entry
  116.         cCurTime,      ; // Current time
  117.         nRow, nCol       // Position on entry
  118.  
  119. IF cOldTime == NIL
  120.     cOldTime := TIME()
  121.     nWaited  := 0
  122. ENDIF
  123.  
  124. cCurTime := TIME()
  125.  
  126. IF !( cCurTime == cOldTime )
  127.     cOldColor := SETCOLOR( "W+/B" )
  128.     nRow      := ROW()
  129.     nCol      := COL()
  130.  
  131.     @ 10,28 SAY cCurTime
  132.  
  133.     cOldTime := cCurTime
  134.  
  135.     IF LastInkey( , TRUE ) == 0
  136.         ++ nWaited
  137.     ELSE
  138.         nWaited := 0
  139.     ENDIF
  140.  
  141.     IF nWaited > 10
  142.         nWaited := 0
  143.  
  144.         TONE( 250, 1 )
  145.  
  146.         @ 8,25 SAY "Well... press a key!"
  147.  
  148.         InterruptKey(3)
  149.  
  150.         @ 8,25 SAY SPACE(20)
  151.     ENDIF
  152.  
  153.     SETPOS( nRow, nCol )
  154.     SETCOLOR( cOldColor )
  155. ENDIF
  156.  
  157. RETURN NIL
  158. //
  159. // EOP: MyInterrupt
  160. //
  161.