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

   EX5.PRG - CUA-Clip Library examples.

   This file contains sample code combining STDBrowse, GETs and
   the Event system in one module.

   Author: Dave Rooney
   Date  : Feb. 23, 1993

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

#include "Demo.CH"


//
// Example 5 - STDBrowse with a menu.
//

FUNCTION TheWholeThing

LOCAL cScreen,    ; // Screen on entry
      bInterrupt, ; // Interrupt code block on entry
      aFields,    ; // Fields array for the browse
      aMenu,      ; // Menu array for the browse
      cColor,     ; // Colour string for the browse
      cTitle,     ; // Title text
      i             // Loop counter

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

//
// Open the printer file.
//
IF DBNetUse( .T., "DBFNTX", "Printer" )
   DBSETINDEX( "Printer" )
ELSE
   RETURN NIL
ENDIF

cScreen := SAVESCREEN()

//
// 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() } )

//
// Build the menu array...
//
aMenu := {;
   { "~Add",      {|| AddModPrinter(.T.) } }, ;
   { "~Modify",   {|| AddModPrinter(.F.) } }, ;
   { "~Delete",   {|| DeletePrinter() } } }

//
// Fields array for the STDBrowse...
//
aFields := { ;
   { "Printer Name", {|| FIELD->PrnName } }, ;
   { "Port",         {|| PADC( FIELD->Port, 6 ) } }, ;
   { "PostScript",   {|| PADC( IF( FIELD->PostScript, "Yes", "No" ), 10 ) } } }

cColor := "B/BG,GR+/BG,W+/BG,W+/R"
cTitle := " Printer File "

//
// Browse it!!
//
STDBrowse( 5, 3, MAXROW() - 5, MAXCOL() - 3, aFields, cTitle,, ;
            cColor, .F., aMenu )

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

//
// Reset the interrupt code block...
//
SetInterrupt( bInterrupt )

RESTSCREEN(,,,, cScreen )

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


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

   FUNCTION AddModPrinter

   This function is used to add a new printer to the list, or
   modify an existing one.

   Parameters: lAddFlag - .T. if adding, .F. if modifying.

      Returns: .T.

*******************************************************************/
STATIC FUNCTION AddModPrinter ( lAddFlag )

LOCAL cScreen,       ; // Screen behind the dialog box
      cOldColor,     ; // Colour on entry
      GetList,       ; // Local GetList array
      cPrinter,      ; // Name of the printer
      cPort,         ; // 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 Add/Modify

//
// Initialize the variables...
//
cOldColor := SETCOLOR()
GetList   := {}
lProceed  := .F.

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

IF lAddFlag
   cPrinter    := SPACE(30)
   cPort       := "LPT1"
   lPostScript := .F.
ELSE
   IF RLOCK()
      cPrinter    := Printer->PrnName
      cPort       := Printer->Port
      lPostScript := Printer->PostScript
   ELSE
      TONE( 250, 1 )
      ALERT( "Could not lock record!" )
      RETURN .T.
   ENDIF
ENDIF

//
// Display the dialog box
//
cScreen := ShadowBox( 2, 12, 13, 68, 2, "GR+/B" )

SETCOLOR( "W+/B" )

@ 2,15 SAY "[ CUA-Clip Interface Library - GET System Examples ]"

SETCOLOR( "BG+/B" )

@  4,15 SAY "      Name:"
@  6,15 SAY "      Port:"
@  8,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.
//
@ 4,27 GET cPrinter ;
         VALID V_Printer( cPrinter, lAddFlag ) ;
         COLOR "W+/N, W+/R, W/N" ;
         MESSAGE "Enter the name of the printer"

//
// Radio buttons - nothing too fancy here!
//
@ 6,27 GET cPort USING RADIO WITH aPorts ;
         WHEN !EMPTY( cPrinter ) ;
         VALID cPort $ "LPT1|LPT2|LPT3" ;
         COLOR "W+/B, W+/R, W/B" ;
         MESSAGE "Select the port for the printer"

//
// Check box - piece of cake!
//
@ 8,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.
//
@ 10,25 BUTTON "  ~Save  " ;
         WHEN Updated() ;
         ACTION ( lProceed := ( ValidGets() == 0 ) ) ;
         COLOR "W+/BG, W+/R, N/BG"

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

READ

//
// Is the user selected 'Save', write the changes to the file.
//
IF lProceed
   IF lAddFlag
      //
      // Add a new record...
      //
      DBAPPEND()
   ENDIF

   REPLACE Printer->PrnName      WITH cPrinter
   REPLACE Printer->Port         WITH cPort
   REPLACE Printer->PostScript   WITH lPostScript

   //
   // Unlock the record & flush the buffers to disk.
   //
   DBUNLOCK()
   DBCOMMIT()
ENDIF

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

SETCOLOR( cOldColor )

RETURN .T.
//
// EOP: AddModPrinter
//


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

   FUNCTION DeletePrinter

   This function is used to delete a printer from the list.

   Parameters: None.

      Returns: .T.

*******************************************************************/
STATIC FUNCTION DeletePrinter

LOCAL cScreen,       ; // Screen behind the dialog box
      cOldColor,     ; // Colour on entry
      GetList,       ; // Local GetList array
      cPrinter,      ; // Name of the printer
      lProceed         // .T. if proceeding with the Add/Modify

//
// Initialize the variables...
//
cOldColor := SETCOLOR()
GetList   := {}
cPrinter  := ALLTRIM( Printer->PrnName )
lProceed  := .F.

//
// Display the dialog box
//
cScreen := ShadowBox( 5, 12, 14, 68, 2, "GR+/B" )

SETCOLOR( "W+/B" )

@ 7,14 SAY "Delete this printer from the file?"

SETCOLOR( "GR+/B" )

@ 9,14 SAY cPrinter

@ 11,25 BUTTON "  Delete  " ;
         ACTION ( lProceed := .T. ) ;
         COLOR "W+/BG, W+/R, N/BG"

@ 11,43 BUTTON " Cancel " ;
         ACTION !( lProceed := .F. ) ;
         COLOR "W+/BG, W+/R, N/BG"

READ

//
// Is the user selected 'Delete', turf that record!
//
IF lProceed
   IF RLOCK()
      //
      // Mark the record for deletion!
      //
      DBDELETE()

      //
      // Unlock the record & flush the buffers to disk.
      //
      DBUNLOCK()
      DBCOMMIT()
   ELSE
      TONE( 250, 1 )
      ALERT( "Could not lock record!" )
   ENDIF
ENDIF

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

SETCOLOR( cOldColor )

RETURN .T.
//
// EOP: DeletePrinter
//


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

   FUNCTION V_Printer

   This function is used to validate the printer name entered.

   If the user is adding a new printer, the function ensures that
   the printer name has not already been used.  If the user is modifying,
   ensure that the name has not been used for another printer.

   Parameters: cPrinter - The name of the printer to validate.
               lAddFlag - .T. if adding, .F. if modifying.

      Returns: .T. if valid, .F. otherwise.

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

STATIC FUNCTION V_Printer ( cPrinter, lAddFlag )

LOCAL lRetCode,   ; // Function's return code
      nRecNo,     ; // Record number on entry
      x

lRetCode := .F.         // I'm a pessimist!
nRecNo   := RECNO()

IF lAddFlag
   //
   // Adding a printer, so simply check for an existing printer
   // of the same name. If one is there, the name is invalid!
   //
   lRetCode := !DBSEEK( UPPER( cPrinter ), .F. )
ELSE
   //
   // Modifying is a bit different.  If the printer name is found in
   // the file, it could simply be the same record that we're
   // modifying!!  Soooo, compare the record number with that on
   // entry.  If they're different, then there's another printer
   // with the same name - the entry is then invalid.
   //
   IF DBSEEK( UPPER( cPrinter ), .F. )
      lRetCode := ( RECNO() == nRecNo )   // Is it the same record?
   ELSE
      lRetCode := .T.
   ENDIF
ENDIF

IF !lRetCode
   TONE( 250, 1 )

   IF EMPTY( cPrinter )
      ALERT( "You must enter a printer name!" )
   ELSE
      ALERT( "That printer already exists!" )
   ENDIF
ENDIF

//
// Reset the record pointer.
//
DBGOTO( nRecNo )

RETURN lRetCode
//
// EOP: V_Printer
//


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

   FUNCTION MyInterrupt

   This is our background function that will be called during the
   InterruptKey wait state.

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

LOCAL cOldColor,     ; // Colour on entry
      cCurTime,      ; // Current time
      nRow, nCol       // Position on entry

IF cOldTime == NIL
   cOldTime := TIME()
ENDIF

cCurTime := TIME()

IF !( cCurTime == cOldTime )
   cOldColor := SETCOLOR( "W+/B" )
   nRow      := ROW()
   nCol      := COL()

   @ 0,MAXCOL() - 9 SAY cCurTime

   cOldTime := cCurTime

   SETPOS( nRow, nCol )
   SETCOLOR( cOldColor )
ENDIF

RETURN NIL
//
// EOP: MyInterrupt
//