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