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