home *** CD-ROM | disk | FTP | other *** search
/ Monster Media 1993 #2 / Image.iso / clipper / cuaclip.zip / EX1.PRG < prev    next >
Text File  |  1993-06-01  |  4KB  |  182 lines
  1. /*********************************************************************
  2.  
  3.     EX1.PRG - CUA-Clip Library examples.
  4.  
  5.     This file contains sample code illustrating the GET system.
  6.  
  7. NOTES:
  8.  
  9. 1) This example will create the files Printer.DBF and Printer.NTX.
  10.  
  11. 2) Also contains samples of:
  12.  
  13.         - DBNetUse/DBNetClose
  14.         - ShadowBox
  15.         - Alert
  16.         - SetMessColor
  17.         - SetListKey
  18.         - ValidGets
  19.  
  20.  
  21. Author: Dave Rooney
  22. Date  : Feb. 22, 1993
  23.  
  24. *********************************************************************/
  25.  
  26. #include "Demo.CH"
  27.  
  28. //
  29. // Example 1 - Standard GETs & Buttons
  30. //
  31.  
  32. FUNCTION GET_Examples
  33.  
  34. LOCAL cScreen,       ; // Screen behind the dialog box
  35.         cOldColor,     ; // Colour on entry
  36.         GetList,       ; // Local GetList array
  37.         cPrinter,      ; // Name of the printer
  38.         nPort,         ; // Printer port selected
  39.         lPostScript,   ; // .T. if the printer is PostScript
  40.         aPrinters,     ; // DBLIST array for the Printer lookup
  41.         aPorts,        ; // Radio button array for the Printer port
  42.         lProceed,      ; // .T. if proceeding with the update
  43.         cMsgText,      ; // Text for the ALERT message
  44.         aOptions,      ; // Options array for the ALERT
  45.         nChoice,       ; // Selection from the ALERT
  46.         lExit            // Loop control flag
  47.  
  48. //
  49. // Initialize the variables...
  50. //
  51. cOldColor   := SETCOLOR()
  52. GetList     := {}
  53. cPrinter    := SPACE(30)
  54. nPort       := 1
  55. lPostScript := .F.
  56. lProceed    := .F.
  57. lExit       := .F.
  58.  
  59. //
  60. // Ensure Printer.DBF/.NTX are there.  If not, make 'em!
  61. //
  62. IF !( FILE( "Printer.DBF" ) .AND. FILE( "Printer.NTX" ))
  63.     _BuildPrinter()
  64. ENDIF
  65.  
  66. //
  67. // Radio button array for the printer port...
  68. //
  69. aPorts := { { { 1, "LPT1" }, { 2, "LPT2" }, { 3, "LPT3" } } }
  70.  
  71. //
  72. // List of available printers:
  73. //
  74. //              Table      Index           Display Exp.        Search Exp.
  75. //                v          v                  v                   v
  76. //
  77. aPrinters := { "Printer", "Printer",, {|| FIELD->PrnName },, {|x| UPPER(x) } }
  78.  
  79. //
  80. // Open the printer file.
  81. //
  82. IF DBNetUse( .T., "DBFNTX", "Printer" )
  83.     DBSETINDEX( "Printer" )
  84. ELSE
  85.     SETCOLOR( cOldColor )
  86.     RETURN NIL
  87. ENDIF
  88.  
  89. //
  90. // Display the dialog box
  91. //
  92. cScreen := ShadowBox( 2, 12, 12, 64, 2, "GR+/B" )
  93.  
  94. SETCOLOR( "W+/B" )
  95.  
  96. @ 2,13 SAY "[ CUA-Clip Interface Library - GET System Examples ]"
  97.  
  98. SETCOLOR( "BG+/B" )
  99.  
  100. @  4,15 SAY "   Printer:"
  101. @  4,59 SAY "<F2>"
  102. @  6,15 SAY "      Port:"
  103. @  8,15 SAY "PostScript:"
  104.  
  105. //
  106. // Standard GET with a database list.  Note the use of Monitor() to
  107. // refresh all of the GETs after a printer name has been entered.
  108. // This will change the colour of the radio buttons and check box
  109. // from dimmed to normal.
  110. //
  111. @ 4,27 GET cPrinter PICTURE "@!" ;
  112.             VALID Printer->( DBSEEK( UPPER( cPrinter ), .F. )) .AND. Monitor() ;
  113.             DBLIST aPrinters ;
  114.             COLOR "W+/N, W+/R, W/N" ;
  115.             MESSAGE "Enter the name of the printer"
  116.  
  117. //
  118. // Radio buttons - nothing too fancy here!
  119. //
  120. @ 6,27 GET nPort USING RADIO WITH aPorts ;
  121.             WHEN !EMPTY( cPrinter ) ;
  122.             VALID ( nPort > 0 ) ;
  123.             COLOR "W+/B, W+/R, W/B" ;
  124.             MESSAGE "Select the port for the printer"
  125.  
  126. //
  127. // Check box - piece of cake!
  128. //
  129. @ 8,27 GET lPostScript USING CHECK ;
  130.             WHEN !EMPTY( cPrinter ) ;
  131.             COLOR "W+/B, W+/R, W/B" ;
  132.             MESSAGE "Is it a PostScript printer?"
  133.  
  134. //
  135. // Push buttons - code 'em in your sleep!  Note that the ACTION expression
  136. // returns a logical value: .T. means end the READ, .F. means continue.
  137. //
  138. @ 10,25 BUTTON "  ~OK  " ;
  139.             ACTION lProceed := ( ValidGets() == 0 ) ;
  140.             COLOR "W+/BG, W+/R, N/BG, R/BG, N/BG"
  141.  
  142. @ 10,43 BUTTON " E~xit " ;
  143.             ACTION !( lProceed := .F. ) ;
  144.             COLOR "W+/BG, W+/R, N/BG, R/BG, N/BG"
  145.  
  146. DO WHILE !lExit
  147.     READ SAVE            // Use "SAVE" so that the GETs aren't cleared!
  148.  
  149.     IF lProceed
  150.         cMsgText := "You selected: " + ALLTRIM( cPrinter ) + ;
  151.                         IF( lPostScript, " (PostScript) ", " " ) + ;
  152.                         "on LPT" + ALLTRIM( STR( nPort ))
  153.  
  154.         aOptions := { "Continue", "Exit" }
  155.  
  156.         //                Message   Options        Colours        Beep  Shadow
  157.         //                   v         v              v             v    v
  158.         nChoice := ALERT( cMsgText, aOptions, "W+/BG, W+/R, W+/B", .F., .T. )
  159.  
  160.         lExit := ( nChoice == 2 )
  161.     ELSE
  162.         lExit := .T.
  163.     ENDIF
  164. ENDDO
  165.  
  166. //
  167. // Get rid of the dialog box...
  168. //
  169. KillBox( cScreen )
  170.  
  171. //
  172. // Close the printer file...
  173. //
  174. DBNetClose( "Printer" )
  175.  
  176. SETCOLOR( cOldColor )
  177.  
  178. RETURN NIL
  179. //
  180. // That's all folks!
  181. //
  182.