home *** CD-ROM | disk | FTP | other *** search
/ Monster Media 1993 #2 / Image.iso / clipper / cuaclip.zip / EX3.PRG < prev    next >
Text File  |  1993-06-01  |  5KB  |  209 lines
  1. /*********************************************************************
  2.  
  3.     EX3.PRG - CUA-Clip Library examples.
  4.  
  5.     This file contains sample code illustrating both the GET
  6.     and Event systems working in combination.
  7.  
  8.     Author: Dave Rooney
  9.     Date  : Feb. 22, 1993
  10.  
  11. *********************************************************************/
  12.  
  13. #include "Demo.CH"
  14.  
  15. //
  16. // Example 3 - Performing GET's while a real-time clock is displayed.
  17. //
  18.  
  19. FUNCTION Combo_Examples
  20.  
  21. LOCAL cScreen,       ; // Screen behind the dialog box
  22.         cOldColor,     ; // Colour on entry
  23.         bInterrupt,    ; // Interrupt code block on entry
  24.         GetList,       ; // Local GetList array
  25.         cPrinter,      ; // Name of the printer
  26.         nPort,         ; // Printer port selected
  27.         lPostScript,   ; // .T. if the printer is PostScript
  28.         aPrinters,     ; // DBLIST array for the Printer lookup
  29.         aPorts           // Radio button array for the Printer port
  30.  
  31. //
  32. // Initialize the variables...
  33. //
  34. cOldColor   := SETCOLOR()
  35. GetList     := {}
  36. cPrinter    := SPACE(30)
  37. nPort       := 1
  38. lPostScript := .F.
  39.  
  40. //
  41. // Set an interrupt function to be called during wait states,
  42. // i.e. InterruptKey().  Note that we're saving the current
  43. // interrupt code block which we'll restore later.
  44. //
  45. bInterrupt := SetInterrupt( {|| MyInterrupt() } )
  46.  
  47. //
  48. // Ensure Printer.DBF/.NTX are there.  If not, make 'em!
  49. //
  50. IF !( FILE( "Printer.DBF" ) .AND. FILE( "Printer.NTX" ))
  51.     _BuildPrinter()
  52. ENDIF
  53.  
  54. //
  55. // Radio button array for the printer port...
  56. //
  57. aPorts := { { { 1, "LPT1" }, { 2, "LPT2" }, { 3, "LPT3" } } }
  58.  
  59. //
  60. // List of available printers:
  61. //
  62. //              Table      Index           Display Exp.        Search Exp.
  63. //                v          v                  v                   v
  64. //
  65. aPrinters := { "Printer", "Printer",, {|| FIELD->PrnName },, {|x| UPPER(x) } }
  66.  
  67. //
  68. // Open the printer file.
  69. //
  70. IF DBNetUse( .T., "DBFNTX", "Printer" )
  71.     DBSETINDEX( "Printer" )
  72. ELSE
  73.     SETCOLOR( cOldColor )
  74.     RETURN NIL
  75. ENDIF
  76.  
  77. //
  78. // Display the dialog box
  79. //
  80. cScreen := ShadowBox( 2, 12, 16, 68, 2, "GR+/B" )
  81.  
  82. SETCOLOR( "W+/B" )
  83.  
  84. @ 2,15 SAY "[ CUA-Clip Interface Library - GET System Examples ]"
  85. @ 15,14 SAY "Time:"
  86.  
  87. SETCOLOR( "BG+/B" )
  88.  
  89. @  4,15 SAY "   Printer:"
  90. @  4,59 SAY "<F2>"
  91. @  6,15 SAY "      Port:"
  92. @  8,15 SAY "PostScript:"
  93.  
  94. //
  95. // Standard GET with a database list.  Note the use of Monitor() to
  96. // refresh all of the GETs after a printer name has been entered.
  97. // This will change the colour of the radio buttons and check box
  98. // from dimmed to normal.
  99. //
  100. @ 4,27 GET cPrinter PICTURE "@!" ;
  101.             VALID Printer->( DBSEEK( UPPER( cPrinter ), .F. )) .AND. Monitor() ;
  102.             DBLIST aPrinters ;
  103.             COLOR "W+/N, W+/R, W/N" ;
  104.             MESSAGE "Enter the name of the printer"
  105.  
  106. //
  107. // Radio buttons - nothing too fancy here!
  108. //
  109. @ 6,27 GET nPort USING RADIO WITH aPorts ;
  110.             WHEN !EMPTY( cPrinter ) ;
  111.             VALID ( nPort > 0 ) ;
  112.             COLOR "W+/B, W+/R, W/B" ;
  113.             MESSAGE "Select the port for the printer"
  114.  
  115. //
  116. // Check box - piece of cake!
  117. //
  118. @ 8,27 GET lPostScript USING CHECK ;
  119.             WHEN !EMPTY( cPrinter ) ;
  120.             COLOR "W+/B, W+/R, W/B" ;
  121.             MESSAGE "Is it a PostScript printer?"
  122.  
  123. //
  124. // Push buttons - code 'em in your sleep!  Note that the ACTION expression
  125. // returns a logical value: .T. means end the READ, .F. means continue.
  126. //
  127. @ 10,25 BUTTON "  ~Save  " ;
  128.             WHEN Updated() ;
  129.             ACTION .T. ;
  130.             COLOR "W+/BG, W+/R, N/BG, R/BG, N/BG"
  131.  
  132. @ 10,43 BUTTON " ~Abort " ;
  133.             ACTION .T. ;
  134.             COLOR "W+/BG, W+/R, N/BG, R/BG, N/BG"
  135.  
  136. READ
  137.  
  138. //
  139. // Get rid of the dialog box...
  140. //
  141. KillBox( cScreen )
  142.  
  143. //
  144. // Close the printer file...
  145. //
  146. DBNetClose( "Printer" )
  147.  
  148. //
  149. // Reset the interrupt code block.
  150. //
  151. SetInterrupt( bInterrupt )
  152.  
  153. SETCOLOR( cOldColor )
  154.  
  155. RETURN NIL
  156. //
  157. // That's all folks!
  158. //
  159.  
  160.  
  161. /*******************************************************************
  162.  
  163.     FUNCTION MyInterrupt
  164.  
  165.     This is our background function that will be called during the
  166.     InterruptKey wait state.
  167.  
  168. NOTE: You must remember that this function will be called many times!
  169.         As such its processing must be kept to a minimum.  In this case
  170.         we will only redisplay the time if it has changed.
  171.  
  172.     Parameters: None.
  173.  
  174.         Returns: NIL
  175.  
  176. *******************************************************************/
  177.  
  178. STATIC FUNCTION MyInterrupt
  179.  
  180. STATIC cOldTime
  181.  
  182. LOCAL cOldColor,     ; // Colour on entry
  183.         cCurTime,      ; // Current time
  184.         nRow, nCol       // Position on entry
  185.  
  186. IF cOldTime == NIL
  187.     cOldTime := TIME()
  188. ENDIF
  189.  
  190. cCurTime := TIME()
  191.  
  192. IF !( cCurTime == cOldTime )
  193.     cOldColor := SETCOLOR( "W+/B" )
  194.     nRow      := ROW()
  195.     nCol      := COL()
  196.  
  197.     @ 15,20 SAY cCurTime
  198.  
  199.     cOldTime := cCurTime
  200.  
  201.     SETPOS( nRow, nCol )
  202.     SETCOLOR( cOldColor )
  203. ENDIF
  204.  
  205. RETURN NIL
  206. //
  207. // EOP: MyInterrupt
  208. //
  209.