home *** CD-ROM | disk | FTP | other *** search
/ Programming Languages Suite / ProgramD2.iso / Database / CLIPR502.DOS / SOURCE / SYS / LBLRUN.PRG < prev    next >
Text File  |  1993-02-15  |  7KB  |  289 lines
  1. /***
  2. *
  3. *  Lblrun.prg
  4. *
  5. *  Clipper LABEL FORM runtime system
  6. *
  7. *  Copyright (c) 1990-1993, Computer Associates International, Inc.
  8. *  All rights reserved.
  9. *
  10. *  Compile: /m /n /w
  11. *
  12. */
  13.  
  14. #include "lbldef.ch"                 // Label array definitions
  15. #include "error.ch"
  16.  
  17. // File-wide static declarations
  18. // Label definition array
  19. STATIC aLabelData := {}
  20. STATIC aBandToPrint := {}
  21. STATIC cBlank := ""
  22. STATIC lOneMoreBand := .T.
  23. STATIC nCurrentCol  := 1            // The current column in the band
  24.  
  25. /***
  26. *
  27. *  __LabelForm( <cLBLName>, [<lPrinter>], <cAltFile>, [<lNoConsole>],
  28. *        <bFor>, <bWhile>, <nNext>, <nRecord>, <lRest>, [<lSample>] )
  29. *
  30. *  Print the specified (.lbl) definition for specified records
  31. *  meeting specified scope and condition
  32. *
  33. */
  34. PROCEDURE __LabelForm( cLBLName, lPrinter, cAltFile, lNoConsole, bFor, ;
  35.                        bWhile, nNext, nRecord, lRest, lSample )
  36.    LOCAL lPrintOn := .F.               // PRINTER status
  37.    LOCAL lConsoleOn                    // CONSOLE status
  38.    LOCAL cExtraFile, lExtraState       // EXTRA file status
  39.    LOCAL xBreakVal, lBroke := .F.
  40.    LOCAL err
  41.    Local OldMargin
  42.  
  43.  
  44.    // Resolve parameters
  45.    IF cLBLName == NIL
  46.       err := ErrorNew()
  47.       err:severity := ES_ERROR
  48.       err:genCode := EG_ARG
  49.       err:subSystem := "FRMLBL"
  50.       Eval(ErrorBlock(), err)
  51.  
  52.    ELSE
  53.       IF AT( ".", cLBLName ) == 0
  54.          cLBLName := TRIM( cLBLName ) + ".LBL"
  55.       ENDIF
  56.  
  57.    ENDIF
  58.  
  59.    IF lPrinter == NIL
  60.       lPrinter := .F.
  61.    ENDIF
  62.  
  63.    IF lSample == NIL
  64.       lSample := .F.
  65.    ENDIF
  66.  
  67.    // Set output devices
  68.    IF lPrinter             // To the printer
  69.       lPrintOn  := SET( _SET_PRINTER, lPrinter )
  70.    ENDIF
  71.  
  72.    lConsoleOn := SET( _SET_CONSOLE )
  73.    SET( _SET_CONSOLE, ! ( lNoConsole .OR. !lConsoleOn ) )
  74.  
  75.    IF (!Empty(cAltFile))         // To file
  76.       cExtraFile  := SET( _SET_EXTRAFILE, cAltFile )
  77.       lExtraState := SET( _SET_EXTRA, .T. )
  78.    ENDIF
  79.  
  80.    OldMargin := SET( _SET_MARGIN, 0)
  81.    
  82.    BEGIN SEQUENCE
  83.  
  84.       aLabelData := __LblLoad( cLBLName )  // Load the (.lbl) into an array
  85.  
  86.       // Add to the left margin if a SET MARGIN has been defined
  87.       aLabelData[ LB_LMARGIN ] += OldMargin
  88.  
  89.       // Size the aBandToPrint array to the number of fields
  90.       ASIZE( aBandToPrint, LEN( aLabelData[ LB_FIELDS ] ) )
  91.       AFILL( aBandToPrint, SPACE( aLabelData[ LB_LMARGIN ] ) )
  92.  
  93.       // Create enough space for a blank record
  94.       cBlank := SPACE( aLabelData[ LB_WIDTH ] + aLabelData[ LB_SPACES ] )
  95.  
  96.       // Handle sample labels
  97.       IF lSample
  98.          SampleLabels()
  99.       ENDIF
  100.  
  101.       // Execute the actual label run based on matching records
  102.       DBEval( { || ExecuteLabel() }, bFor, bWhile, nNext, nRecord, lRest )
  103.  
  104.       // Print the last band if there is one
  105.       IF lOneMoreBand
  106.          // Print the band
  107.          AEVAL( aBandToPrint, { | BandLine | PrintIt( BandLine ) } )
  108.  
  109.       ENDIF
  110.  
  111.  
  112.    RECOVER USING xBreakVal
  113.  
  114.       lBroke := .T.
  115.  
  116.    END SEQUENCE
  117.  
  118.    // Clean up and leave
  119.    aLabelData   := {}                // Recover the space
  120.    aBandToPrint := {}
  121.    nCurrentCol  := 1
  122.    cBlank       := ""
  123.    lOneMoreBand :=.T.
  124.  
  125.    // clean up
  126.    SET( _SET_PRINTER, lPrintOn ) // Set the printer back to prior state
  127.    SET( _SET_CONSOLE, lConsoleOn )  // Set the console back to prior state
  128.  
  129.    IF (!Empty(cAltFile))            // Set extrafile back
  130.       SET( _SET_EXTRAFILE, cExtraFile )
  131.       SET( _SET_EXTRA, lExtraState )
  132.    ENDIF
  133.  
  134.    IF lBroke
  135.       BREAK xBreakVal               // continue breaking
  136.    ENDIF
  137.  
  138.    SET( _SET_MARGIN, OldMargin)
  139.    
  140.    RETURN
  141.  
  142. /***
  143. *
  144. *  ExecuteLabel()
  145. *  Process the label array using the current record
  146. *
  147. */
  148. STATIC PROCEDURE ExecuteLabel
  149.    LOCAL nField, nMoreLines, aBuffer := {}, cBuffer
  150.    LOCAL v
  151.  
  152.    // Load the current record into aBuffer
  153.    FOR nField := 1 TO LEN( aLabelData[ LB_FIELDS ] )
  154.  
  155.       if ( aLabelData[ LB_FIELDS, nField ] <> NIL )
  156.  
  157.          v := Eval( aLabelData[ LB_FIELDS, nField, LF_EXP ] )
  158.  
  159.          cBuffer := PadR( v, aLabelData[ LB_WIDTH ] )
  160.          cBuffer += Space( aLabelData[ LB_SPACES ] )
  161.  
  162.          if ( aLabelData[ LB_FIELDS, nField, LF_BLANK ] )
  163.             if ( !Empty( cBuffer ) )
  164.                AADD( aBuffer, cBuffer )
  165.             end
  166.          else
  167.             AADD( aBuffer, cBuffer )
  168.          endif
  169.  
  170.       else
  171.  
  172.          AADD( aBuffer, NIL )
  173.  
  174.       end
  175.  
  176.    NEXT
  177.  
  178.    ASIZE( aBuffer, LEN( aLabelData[ LB_FIELDS ] ) )
  179.  
  180.    // Add aBuffer to aBandToPrint
  181.    FOR nField := 1 TO LEN( aLabelData[ LB_FIELDS ] )
  182.       IF aBuffer[ nField ] == NIL
  183.          aBandToPrint[ nField ] += cBlank
  184.       ELSE
  185.          aBandToPrint[ nField ] += aBuffer[ nField ]
  186.       ENDIF
  187.    NEXT
  188.  
  189.    IF nCurrentCol == aLabelData[ LB_ACROSS ]
  190.  
  191.      // trim
  192.      FOR nField := 1 TO LEN( aBandToPrint )
  193.        aBandToPrint[ nField ] := Trim( aBandToPrint[ nField ] )
  194.      NEXT
  195.  
  196.  
  197.       lOneMoreBand := .F.
  198.       nCurrentCol  := 1
  199.  
  200.       // Print the band
  201.       AEVAL( aBandToPrint, { | BandLine | PrintIt( BandLine ) } )
  202.  
  203.       nMoreLines := aLabelData[ LB_HEIGHT ] - LEN( aBandToPrint )
  204.       IF nMoreLines > 0
  205.          FOR nField := 1 TO nMoreLines
  206.             PrintIt()
  207.          NEXT
  208.       ENDIF
  209.       IF aLabelData[ LB_LINES ] > 0
  210.  
  211.          // Add the spaces between the label lines
  212.          FOR nField := 1 TO aLabelData[ LB_LINES ]
  213.             PrintIt()
  214.          NEXT
  215.  
  216.       ENDIF
  217.  
  218.       // Clear out the band
  219.       AFILL( aBandToPrint, SPACE( aLabelData[ LB_LMARGIN ] ) )
  220.    ELSE
  221.       lOneMoreBand := .T.
  222.       nCurrentCol++
  223.    ENDIF
  224.  
  225.    RETURN
  226.  
  227. /***
  228. *
  229. *  SampleLabels()
  230. *  Print sample labels
  231. *
  232. */
  233. STATIC PROCEDURE SampleLabels
  234.    LOCAL nGetKey, lMoreSamples := .T., nField
  235.    LOCAL aBand := {}
  236.  
  237.    // Create the sample label row
  238.    ASIZE( aBand, aLabelData[ LB_HEIGHT ] )
  239.    AFILL( aBand, SPACE( aLabelData[ LB_LMARGIN ] ) +;
  240.               REPLICATE( REPLICATE( "*", ;
  241.               aLabelData[ LB_WIDTH ] ) + ;
  242.               SPACE( aLabelData[ LB_SPACES ] ), ;
  243.               aLabelData[ LB_ACROSS ] ) )
  244.  
  245.    // Prints sample labels
  246.    DO WHILE lMoreSamples
  247.  
  248.       // Print the samples
  249.       AEVAL( aBand, { | BandLine | PrintIt( BandLine ) } )
  250.  
  251.       IF aLabelData[ LB_LINES ] > 0
  252.          // Add the spaces between the label lines
  253.          FOR nField := 1 TO aLabelData[ LB_LINES ]
  254.             PrintIt()
  255.          NEXT nField
  256.       ENDIF
  257.  
  258.       // Prompt for more
  259.       @ ROW(), 0 SAY "Do you want more samples? (Y/N)"
  260.       nGetKey := INKEY(0)
  261.       @ ROW(), COL() SAY CHR(nGetKey)
  262.       IF ROW() == MAXROW()
  263.          SCROLL( 0, 0, MAXROW(), MAXCOL(), 1 )
  264.          @ MAXROW(), 0 SAY ""
  265.       ELSE
  266.          @ ROW()+1, 0 SAY ""
  267.       ENDIF
  268.       IF UPPER(CHR(nGetKey)) == "N"
  269.          lMoreSamples := .F.
  270.       ENDIF
  271.    ENDDO
  272.    RETURN
  273.  
  274. /***
  275. *
  276. *  PrintIt( <cString> )
  277. *  Print a string, then send a CRLF
  278. *
  279. */
  280. STATIC PROCEDURE PrintIt( cString )
  281.  
  282.    IF cString == NIL
  283.       cString := ""
  284.    ENDIF
  285.    QQOUT( cString )
  286.    QOUT()
  287.  
  288.    RETURN
  289.