/*********************************************************************

   EX1.PRG - CUA-Clip Library examples.

   This file contains sample code illustrating the GET system.

NOTES:

1) This example will create the files Printer.DBF and Printer.NTX.

2) Also contains samples of:

      - DBNetUse/DBNetClose
      - ShadowBox
      - KillBox()
      - Alert
      - SetMessColor
      - SetListKey
      - ValidGets
      - DBLookUp
      - Monitor

3) LINK --> RTLINK FILE EX1,ERRORSYS LIB CUACLIP

Author: Dave Rooney
Date  : Feb. 22, 1993

*********************************************************************/

#include "CUACLIP.CH"
#include "Inkey.CH"

//
// Example 1 - Standard GETs & Buttons
//

FUNCTION GET_Examples

LOCAL cDOSScreen,    ; // Screen on entry
      cScreen,       ; // Screen behind the dialog box
      cOldColor,     ; // Colour on entry
      GetList,       ; // Local GetList array
      cPrinter,      ; // Name of the printer
      nPort,         ; // Printer port selected
      lPostScript,   ; // .T. if the printer is PostScript
      aPrinters,     ; // DBLIST array for the Printer lookup
      aPorts,        ; // Radio button array for the Printer port
      lProceed,      ; // .T. if proceeding with the update
      cMsgText,      ; // Text for the ALERT message
      aOptions,      ; // Options array for the ALERT
      nChoice,       ; // Selection from the ALERT
      lExit            // Loop control flag

//
// Initialize the variables...
//
cDOSScreen  := SAVESCREEN()
cOldColor   := SETCOLOR()
GetList     := {}
cPrinter    := SPACE(30)
nPort       := 1
lPostScript := .F.
lProceed    := .F.
lExit       := .F.

//
// Ensure Printer.DBF/.NTX are there.  If not, make 'em!
//
IF !( FILE( "Printer.DBF" ) .AND. FILE( "Printer.NTX" ))
   _BuildPrinter()
ENDIF

//
// Radio button array for the printer port...
//
aPorts := { { { 1, "LPT1" }, { 2, "LPT2" }, { 3, "LPT3" } } }

//
// List of available printers:
//
//              Table      Index           Display Exp.        Search .Exp.
//                v          v                  v                   v
//
aPrinters := { "Printer", "Printer",, {|| FIELD->PrnName },, {|x| UPPER(x) } }

//
// Some system settings...
//
SET EXCLUSIVE OFF                      // Need this for DBLIST!
SET MESSAGE TO MAXROW() CENTER

SetMessColor( "BG+/B" )                // Message area colour
SetPopColor( "GR+/B, W+/R, W+/B" )     // Colours for popup lists
SetListKey( K_F2 )                     // Popup list hot-key

//
// Open the printer file.
//
IF DBNetUse( .T., "DBFNTX", "Printer" )
   DBSETINDEX( "Printer" )
ELSE
   SETCOLOR( cOldColor )
   RESTSCREEN(,,,, cDOSScreen )

   RETURN NIL
ENDIF

//
// Display the dialog box
//
cScreen := ShadowBox( 1, 12, 11, 64, 2, "GR+/B" )

SETCOLOR( "W+/B" )

@ 1,13 SAY "[ CUA-Clip Interface Library - GET System Examples ]"

SETCOLOR( "BG+/B" )

@  3,15 SAY "   Printer:"
@  3,59 SAY "<F2>"
@  5,15 SAY "      Port:"
@  7,15 SAY "PostScript:"

//
// Standard GET with a database list.  Note the use of Monitor() to
// refresh all of the GETs after a printer name has been entered.
// This will change the colour of the radio buttons and check box
// from dimmed to normal.
//
@ 3,27 GET cPrinter PICTURE "@!" ;
         VALID DBLookUp( UPPER( cPrinter ), "Printer", "Printer" ) .AND. ;
               Monitor() ;
         DBLIST aPrinters ;
         COLOR "W+/N, W+/R, W/N" ;
         MESSAGE "Enter the name of the printer"

//
// Radio buttons - nothing too fancy here!
//
@ 5,27 GET nPort USING RADIO WITH aPorts ;
         WHEN !EMPTY( cPrinter ) ;
         VALID ( nPort > 0 ) ;
         COLOR "W+/B, W+/R, W/B" ;
         MESSAGE "Select the port for the printer"

//
// Check box - piece of cake!
//
@ 7,27 GET lPostScript USING CHECK ;
         WHEN !EMPTY( cPrinter ) ;
         COLOR "W+/B, W+/R, W/B" ;
         MESSAGE "Is it a PostScript printer?"

//
// Push buttons - code 'em in your sleep!  Note that the ACTION expression
// returns a logical value: .T. means end the READ, .F. means continue.
//
@ 9,25 BUTTON "  ~OK  " ;
         ACTION lProceed := ( ValidGets() == 0 ) ;
         COLOR "W+/BG, W+/R, N/BG"

@ 9,43 BUTTON " E~xit " ;
         ACTION !( lProceed := .F. ) ;
         COLOR "W+/BG, W+/R, N/BG"

DO WHILE !lExit
   READ SAVE            // Use "SAVE" so that the GETs aren't cleared!

   IF lProceed
      cMsgText := "You selected: " + ALLTRIM( cPrinter ) + ;
                  IF( lPostScript, " (PostScript) ", " " ) + ;
                  "on LPT" + ALLTRIM( STR( nPort ))

      aOptions := { "Continue", "Exit" }

      //                Message   Options        Colours        Beep  Shadow
      //                   v         v              v             v    v
      nChoice := ALERT( cMsgText, aOptions, "W+/BG, W+/R, W+/B", .F., .T. )

      lExit := ( nChoice == 2 )
   ELSE
      lExit := .T.
   ENDIF
ENDDO

//
// Get rid of the dialog box...
//
KillBox( cScreen )

//
// Close the printer file...
//
DBNetClose( { "Printer" } )

SETCOLOR( cOldColor )
RESTSCREEN(,,,, cDOSScreen )

RETURN NIL
//
// That's all folks!
//


/*******************************************************************

   _BuildPrinter - This function builds the Printer lookup table
                   if it doesn't already exist.

   Parameters: None.

      Returns: NIL

*******************************************************************/

STATIC FUNCTION _BuildPrinter

LOCAL aPrinters,     ; // Array storing printer names
      aStruct,       ; // File structure for Printer.DBF
      i                // Loop counter

aPrinters := { "Epson LQ-1050", "HP LaserJet II", "HP LaserJet III", ;
               "HP LaserJet IIID/IIIsi", "QMS 410 - EMS" }

aStruct := { { "PRNNAME", "C", 30, 0 } }

DBCREATE( "Printer", aStruct )

DBNetUse( .T., "DBFNTX", "Printer", "Printer", .F. )

FOR i := 1 TO LEN( aPrinters )
   DBAPPEND()
   REPLACE FIELD->PrnName WITH aPrinters[i]
DBUNLOCK()
NEXT

DBCOMMIT()

INDEX ON UPPER( FIELD->PrnName ) TO Printer

DBNetClose( "Printer" )

RETURN NIL
//
// EOP: _BuildPrinter
//