home *** CD-ROM | disk | FTP | other *** search
/ Programming Languages Suite / ProgramD2.iso / Database / CLIPR502.DOS / SOURCE / SYS / FRMRUN.PRG < prev    next >
Text File  |  1993-02-15  |  26KB  |  814 lines
  1. /***
  2. *
  3. *  Frmrun.prg
  4. *
  5. *  Clipper REPORT 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 "frmdef.ch"
  15. #include "error.ch"
  16.  
  17. #define S87_COMPAT                    // preserve Summer '87 compatability
  18.  
  19. STATIC aReportData, nPageNumber, nLinesLeft, aReportTotals
  20. STATIC aGroupTotals, lFirstPass, lFormFeeds, nMaxLinesAvail
  21.  
  22. /***
  23. *
  24. *  __ReportForm( <cFRMName>, [<lPrinter>], <cAltFile>,
  25. *         [<lNoConsole>], <bFor>, <bWhile>, <nNext>, <nRecord>,
  26. *         <lRest>, <lPlain>, [<cHeading>], [<lBEject>],
  27. *         [<lSummary>] )
  28. *
  29. */
  30. PROCEDURE __ReportForm( cFRMName, lPrinter, cAltFile, lNoConsole, bFor, ;
  31.                        bWhile, nNext, nRecord, lRest, lPlain, cHeading, ;
  32.                        lBEject, lSummary )
  33.  
  34.    LOCAL lPrintOn, lConsoleOn // Status of PRINTER and CONSOLE
  35.    LOCAL cExtraFile, lExtraState // Status of EXTRA
  36.    LOCAL nCol, nGroup
  37.    LOCAL xBreakVal, lBroke := .F.
  38.    LOCAL err
  39.  
  40.    LOCAL lAnyTotals
  41.    LOCAL lAnySubTotals
  42.     
  43.    // Resolve parameters
  44.    IF cFRMName == NIL
  45.       err := ErrorNew()
  46.       err:severity := ES_ERROR
  47.       err:genCode := EG_ARG
  48.       err:subSystem := "FRMLBL"
  49.       Eval(ErrorBlock(), err)
  50.    ELSE
  51.       IF AT( ".", cFRMName ) == 0
  52.          cFRMName := TRIM( cFRMName ) + ".FRM"
  53.       ENDIF
  54.    ENDIF
  55.  
  56.    IF lPrinter == NIL
  57.      lPrinter   := .F.
  58.    ENDIF
  59.  
  60.    IF cHeading == NIL
  61.      cHeading := ""
  62.    ENDIF
  63.  
  64.    // Set output devices
  65.    lPrintOn   := SET( _SET_PRINTER, lPrinter )
  66.  
  67.    lConsoleOn := SET( _SET_CONSOLE, .F. )
  68.    SET( _SET_CONSOLE, ! ( lNoConsole .OR. !lConsoleOn ) )
  69.  
  70.    IF lPrinter                   // To the printer
  71.      lFormFeeds := .T.
  72.    ELSE
  73.      lFormFeeds := .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.  
  82.    BEGIN SEQUENCE
  83.  
  84.          aReportData := __FrmLoad( cFRMName )  // Load the frm into an array
  85.          nMaxLinesAvail := aReportData[RP_LINES]
  86.  
  87.          // Modify aReportData based on the report parameters
  88.          IF lSummary != NIL             // Set the summary only flag
  89.             aReportData[ RP_SUMMARY ] := lSummary
  90.          ENDIF
  91.          IF lBEject != NIL .AND. lBEject
  92.              aReportData[ RP_BEJECT ]  := .F.
  93.          ENDIF
  94.          IF lPlain                      // Set plain report flag
  95.            aReportData[ RP_PLAIN ]   := .T.
  96.            cHeading               := ""
  97.            lFormFeeds             := .F.
  98.          ENDIF
  99.          aReportData[ RP_HEADING ]    := cHeading
  100.  
  101.          // Add to the left margin if a SET MARGIN has been defined
  102.          // NOTE: uncommenting this line will cause REPORT FORM to respect
  103.          // SET MARGIN to screen/to file, but double the margin TO PRINT
  104.          // aReportData[ RP_LMARGIN ] += SET( _SET_MARGIN )
  105.  
  106.          nPageNumber := 1                  // Set the initial page number
  107.          lFirstPass  := .T.             // Set the first pass flag
  108.  
  109.          nLinesLeft  := aReportData[ RP_LINES ]
  110.  
  111. #ifdef S87_COMPAT
  112.         QOUT()        // output additional line on first page
  113. #endif
  114.  
  115.          // Check to see if a "before report" eject, or TO FILE has been specified
  116.          IF aReportData[ RP_BEJECT ]
  117.           EjectPage()
  118.  
  119.          ENDIF
  120.  
  121.          // Generate the initial report header manually (in case there are no
  122.          // records that match the report scope)
  123.          ReportHeader()
  124.  
  125.          // Initialize aReportTotals to track both group and report totals, then
  126.          // set the column total elements to 0 if they are to be totaled, otherwise
  127.          // leave them NIL
  128.          aReportTotals := ARRAY( LEN(aReportData[RP_GROUPS]) + 1, ;
  129.                            LEN(aReportData[RP_COLUMNS]) )
  130.  
  131.          // Column total elements
  132.          FOR nCol := 1 TO LEN(aReportData[RP_COLUMNS])
  133.            IF aReportData[RP_COLUMNS,nCol,RC_TOTAL]
  134.              FOR nGroup := 1 TO LEN(aReportTotals)
  135.                 aReportTotals[nGroup,nCol] := 0
  136.              NEXT
  137.            ENDIF
  138.          NEXT
  139.  
  140.          // Initialize aGroupTotals as an array
  141.          aGroupTotals := ARRAY( LEN(aReportData[RP_GROUPS]) )
  142.  
  143.          // Execute the actual report based on matching records
  144.          DBEval( { || ExecuteReport() }, bFor, bWhile, nNext, nRecord, lRest )
  145.  
  146.          // Generate any totals that may have been identified
  147.          // Make a pass through all the groups
  148.          FOR nGroup := LEN(aReportData[RP_GROUPS]) TO 1 STEP -1
  149.  
  150.  
  151.            // make sure group has subtotals
  152.            lAnySubTotals := .F.
  153.            FOR nCol := 1 TO LEN(aReportData[RP_COLUMNS])
  154.              IF aReportData[RP_COLUMNS,nCol,RC_TOTAL]
  155.                 lAnySubTotals := .T.
  156.                 EXIT              // NOTE
  157.              ENDIF
  158.            NEXT
  159.  
  160.            IF !lAnySubTotals
  161.              LOOP                 // NOTE
  162.            ENDIF
  163.  
  164.  
  165.            // Check to see if we need to eject the page
  166.            IF nLinesLeft < 2
  167.              EjectPage()
  168.              IF aReportData[ RP_PLAIN ]
  169.                 nLinesLeft := 1000
  170.              ELSE
  171.                 ReportHeader()
  172.              ENDIF
  173.            ENDIF
  174.  
  175.            // Print the first line
  176.            PrintIt( SPACE(aReportData[RP_LMARGIN]) + ;
  177.                 IF(nGroup==1,"** Subtotal **","* Subsubtotal *") )
  178.  
  179.            // Print the second line
  180.            QQOUT( SPACE(aReportData[RP_LMARGIN]) )
  181.            FOR nCol := 1 TO LEN(aReportData[RP_COLUMNS])
  182.              IF nCol > 1
  183.                 QQOUT( " " )
  184.              ENDIF
  185.              IF aReportData[RP_COLUMNS,nCol,RC_TOTAL]
  186.                 QQOUT( TRANSFORM(aReportTotals[nGroup+1,nCol], ;
  187.                   aReportData[RP_COLUMNS,nCol,RC_PICT]) )
  188.              ELSE
  189.                 QQOUT( SPACE(aReportData[RP_COLUMNS,nCol,RC_WIDTH]) )
  190.              ENDIF
  191.            NEXT
  192.  
  193.            // Send a cr/lf for the last line
  194.            QOUT()
  195.  
  196.          NEXT
  197.  
  198.          // Generate the "Grand totals"
  199.          // Check to see if we need to eject the page
  200.          IF nLinesLeft < 2
  201.            EjectPage()
  202.            IF aReportData[ RP_PLAIN ]
  203.              nLinesLeft := 1000
  204.            ELSE
  205.              ReportHeader()
  206.            ENDIF
  207.          ENDIF
  208.  
  209.          // Any report totals?
  210.          lAnyTotals := .F.
  211.          FOR nCol := 1 TO LEN(aReportData[RP_COLUMNS])
  212.            IF aReportData[RP_COLUMNS,nCol,RC_TOTAL]
  213.              lAnyTotals := .T.
  214.              EXIT
  215.            ENDIF
  216.          NEXT nCol
  217.  
  218.  
  219.          IF lAnyTotals
  220.  
  221.             // Print the first line
  222.             PrintIt( SPACE(aReportData[RP_LMARGIN]) + "*** Total ***" )
  223.  
  224.             // Print the second line
  225.             QQOUT( SPACE(aReportData[RP_LMARGIN]) )
  226.             FOR nCol := 1 TO LEN(aReportData[RP_COLUMNS])
  227.               IF nCol > 1
  228.                 QQOUT( " " )
  229.               ENDIF
  230.               IF aReportData[RP_COLUMNS,nCol,RC_TOTAL]
  231.                 QQOUT( TRANSFORM(aReportTotals[1,nCol], ;
  232.                    aReportData[RP_COLUMNS,nCol,RC_PICT]) )
  233.               ELSE
  234.                 QQOUT( SPACE(aReportData[RP_COLUMNS,nCol,RC_WIDTH]) )
  235.               ENDIF
  236.             NEXT nCol
  237.  
  238.             // Send a cr/lf for the last line
  239.             QOUT()
  240.  
  241.          ENDIF
  242.  
  243.          // Check to see if an "after report" eject, or TO FILE has been specified
  244.          IF aReportData[ RP_AEJECT ]
  245.           EjectPage()
  246.          ENDIF
  247.  
  248.  
  249.    RECOVER USING xBreakVal
  250.  
  251.         lBroke := .T.
  252.  
  253.    END SEQUENCE
  254.  
  255.  
  256.    // Clean up and leave
  257.    aReportData   := NIL          // Recover the space
  258.    aReportTotals  := NIL
  259.    aGroupTotals   := NIL
  260.    nPageNumber   := NIL
  261.    lFirstPass    := NIL
  262.    nLinesLeft    := NIL
  263.    lFormFeeds    := NIL
  264.    nMaxLinesAvail := NIL
  265.  
  266.    // clean up
  267.    SET( _SET_PRINTER, lPrintOn )    // Set the printer back to prior state
  268.    SET( _SET_CONSOLE, lConsoleOn )     // Set the console back to prior state
  269.  
  270.    IF (!Empty(cAltFile))            // Set extrafile back
  271.      SET( _SET_EXTRAFILE, cExtraFile )
  272.      SET( _SET_EXTRA, lExtraState )
  273.    ENDIF
  274.  
  275.    IF lBroke
  276.      // keep the break value going
  277.      BREAK xBreakVal
  278.    END
  279.  
  280.    RETURN
  281.  
  282. /***
  283. *  ExecuteReport()
  284. *  Executed by DBEVAL() for each record that matches record scope
  285. */
  286. STATIC PROCEDURE ExecuteReport
  287.    LOCAL aRecordHeader  := {}          // Header for the current record
  288.    LOCAL aRecordToPrint := {}          // Current record to print
  289.    LOCAL nCol                          // Counter for the column work
  290.    LOCAL nGroup                        // Counter for the group work
  291.    LOCAL lGroupChanged  := .F.         // Has any group changed?
  292.     LOCAL lEjectGrp := .F.                    // Group eject indicator
  293.    LOCAL nMaxLines                     // Number of lines needed by record
  294.    LOCAL nLine                         // Counter for each record line
  295.    LOCAL cLine                         // Current line of text for parsing
  296.    LOCAL nLastElement                  // Last element pointer if record is
  297.  
  298.    LOCAL lAnySubTotals
  299.  
  300.    // Add to the main column totals
  301.    FOR nCol := 1 TO LEN(aReportData[RP_COLUMNS])
  302.       IF aReportData[RP_COLUMNS,nCol,RC_TOTAL]
  303.          // If this column should be totaled, do it
  304.          aReportTotals[ 1 ,nCol] += ;
  305.                   EVAL( aReportData[RP_COLUMNS,nCol,RC_EXP] )
  306.       ENDIF
  307.    NEXT
  308.  
  309.    // Determine if any of the groups have changed.  If so, add the appropriate
  310.    // line to aRecordHeader for totaling out the previous records
  311.    IF !lFirstPass                       // Don't bother first time through
  312.  
  313.       // Make a pass through all the groups
  314.       FOR nGroup := LEN(aReportData[RP_GROUPS]) TO 1 STEP -1
  315.  
  316.  
  317.        // make sure group has subtotals
  318.        lAnySubTotals := .F.
  319.        FOR nCol := 1 TO LEN(aReportData[RP_COLUMNS])
  320.          IF aReportData[RP_COLUMNS,nCol,RC_TOTAL]
  321.             lAnySubTotals := .T.
  322.             EXIT              // NOTE
  323.          ENDIF
  324.        NEXT
  325.  
  326.        IF !lAnySubTotals
  327.          LOOP                 // NOTE
  328.        ENDIF
  329.  
  330.          // If this group has changed since the last record
  331.          IF MakeAStr(EVAL(aReportData[RP_GROUPS,nGroup,RG_EXP]),;
  332.                aReportData[RP_GROUPS,nGroup,RG_TYPE]) != aGroupTotals[nGroup]
  333.             AADD( aRecordHeader, IF(nGroup==1,"** Subtotal **","* Subsubtotal *") )
  334.             AADD( aRecordHeader, "" )
  335.  
  336.                 // retrieve group eject state from report form
  337.                 IF ( nGroup == 1 )
  338.                     lEjectGrp := aReportData[ RP_GROUPS, nGroup, RG_AEJECT ]
  339.                 ENDIF
  340.  
  341.             // Cycle through the columns, adding either the group
  342.             // amount from aReportTotals or spaces wide enough for
  343.             // the non-totaled columns
  344.             FOR nCol := 1 TO LEN(aReportData[RP_COLUMNS])
  345.                IF aReportData[RP_COLUMNS,nCol,RC_TOTAL]
  346.                   aRecordHeader[ LEN(aRecordHeader) ] += ;
  347.                      TRANSFORM(aReportTotals[nGroup+1,nCol], ;
  348.                      aReportData[RP_COLUMNS,nCol,RC_PICT])
  349.                   // Zero out the group totals column from aReportTotals
  350.                   aReportTotals[nGroup+1,nCol] := 0
  351.                ELSE
  352.                   aRecordHeader[ LEN(aRecordHeader) ] += ;
  353.                         SPACE(aReportData[RP_COLUMNS,nCol,RC_WIDTH])
  354.                ENDIF
  355.                aRecordHeader[ LEN(aRecordHeader) ] += " "
  356.             NEXT
  357.             // Get rid of the extra space from the last column
  358.             aRecordHeader[LEN(aRecordHeader)] := ;
  359.                   LEFT( aRecordHeader[LEN(aRecordHeader)], ;
  360.                   LEN(aRecordHeader[LEN(aRecordHeader)]) - 1 )
  361.          ENDIF
  362.       NEXT
  363.  
  364.    ENDIF
  365.  
  366.    lFirstPass = .F.
  367.  
  368.     IF ( LEN( aRecordHeader ) > 0 ) .AND. lEjectGrp
  369.         IF LEN( aRecordHeader ) > nLinesLeft
  370.             EjectPage()
  371.  
  372.             IF ( aReportData[ RP_PLAIN ] )    
  373.                 nLinesLeft := 1000
  374.             ELSE
  375.                 ReportHeader()
  376.             ENDIF
  377.  
  378.         ENDIF
  379.  
  380.         AEVAL( aRecordHeader, { | HeaderLine | ;
  381.             PrintIt( SPACE( aReportData[ RP_LMARGIN ] ) + HeaderLine ) } )
  382.  
  383.         aRecordHeader := {}
  384.  
  385.         EjectPage()
  386.  
  387.         IF ( aReportData[ RP_PLAIN ] )
  388.             nLinesLeft := 1000
  389.  
  390.         ELSE
  391.             ReportHeader()
  392.  
  393.         ENDIF
  394.  
  395.     ENDIF    
  396.  
  397.    // Add to aRecordHeader in the event that the group has changed and
  398.    // new group headers need to be generated
  399.  
  400.    // Cycle through the groups
  401.    FOR nGroup := 1 TO LEN(aReportData[RP_GROUPS])
  402.       // If the group has changed
  403.       IF MakeAStr(EVAL(aReportData[RP_GROUPS,nGroup,RG_EXP]),;
  404.             aReportData[RP_GROUPS,nGroup,RG_TYPE]) == aGroupTotals[nGroup]
  405.       ELSE
  406.          AADD( aRecordHeader, "" )   // The blank line
  407.          AADD( aRecordHeader, IF(nGroup==1,"** ","* ") +;
  408.                aReportData[RP_GROUPS,nGroup,RG_HEADER] + " " +;
  409.                MakeAStr(EVAL(aReportData[RP_GROUPS,nGroup,RG_EXP]), ;
  410.                aReportData[RP_GROUPS,nGroup,RG_TYPE]) )
  411.       ENDIF
  412.    NEXT
  413.  
  414.    // Is there anything in the record header?
  415.    IF LEN( aRecordHeader ) > 0
  416.       // Determine if aRecordHeader will fit on the current page.  If not,
  417.       // start a new header
  418.       IF LEN( aRecordHeader ) > nLinesLeft
  419.          EjectPage()
  420.          IF aReportData[ RP_PLAIN ]
  421.             nLinesLeft := 1000
  422.          ELSE
  423.             ReportHeader()
  424.          ENDIF
  425.       ENDIF
  426.  
  427.       // Send aRecordHeader to the output device, resetting nLinesLeft
  428.       AEVAL( aRecordHeader, { | HeaderLine | ;
  429.               PrintIt( SPACE(aReportData[RP_LMARGIN])+ HeaderLine ) } )
  430.  
  431.       nLinesLeft -= LEN( aRecordHeader )
  432.  
  433.       // Make sure it didn't hit the bottom margin
  434.       IF nLinesLeft == 0
  435.          EjectPage()
  436.          IF aReportData[ RP_PLAIN ]
  437.             nLinesLeft := 1000
  438.          ELSE
  439.             ReportHeader()
  440.          ENDIF
  441.       ENDIF
  442.    ENDIF
  443.  
  444.    // Add to the group totals
  445.    FOR nCol := 1 TO LEN(aReportData[RP_COLUMNS])
  446.       // If this column should be totaled, do it
  447.       IF aReportData[RP_COLUMNS,nCol,RC_TOTAL]
  448.          // Cycle through the groups
  449.          FOR nGroup := 1 TO LEN( aReportTotals ) - 1
  450.             aReportTotals[nGroup+1,nCol] += ;
  451.                EVAL( aReportData[RP_COLUMNS,nCol,RC_EXP] )
  452.          NEXT
  453.       ENDIF
  454.    NEXT
  455.  
  456.    // Reset the group expressions in aGroupTotals
  457.    FOR nGroup := 1 TO LEN(aReportData[RP_GROUPS])
  458.       aGroupTotals[nGroup] := MakeAStr(EVAL(aReportData[RP_GROUPS,nGroup,RG_EXP]),;
  459.                                     aReportData[RP_GROUPS,nGroup,RG_TYPE])
  460.    NEXT
  461.  
  462.    // Only run through the record detail if this is NOT a summary report
  463.    IF !aReportData[ RP_SUMMARY ]
  464.       // Determine the max number of lines needed by each expression
  465.      nMaxLines := 1
  466.       FOR nCol := 1 TO LEN(aReportData[RP_COLUMNS])
  467.          IF aReportData[RP_COLUMNS,nCol,RC_TYPE] $ "CM"
  468.             nMaxLines := MAX(XMLCOUNT(EVAL(aReportData[RP_COLUMNS,nCol,RC_EXP]),;
  469.                          aReportData[RP_COLUMNS,nCol,RC_WIDTH]), nMaxLines)
  470.          ENDIF
  471.       NEXT
  472.  
  473.       // Size aRecordToPrint to the maximum number of lines it will need, then
  474.       // fill it with nulls
  475.       ASIZE( aRecordToPrint, nMaxLines )
  476.       AFILL( aRecordToPrint, "" )
  477.  
  478.       // Load the current record into aRecordToPrint
  479.       FOR nCol := 1 TO LEN(aReportData[RP_COLUMNS])
  480.          FOR nLine := 1 TO nMaxLines
  481.             // Check to see if it's a memo or character
  482.             IF aReportData[RP_COLUMNS,nCol,RC_TYPE] $ "CM"
  483.                // Load the current line of the current column into cLine
  484.                cLine := XMEMOLINE(TRIM(EVAL(aReportData[RP_COLUMNS,nCol,RC_EXP])),;
  485.                              aReportData[RP_COLUMNS,nCol,RC_WIDTH], nLine )
  486.                cLine := PADR( cLine, aReportData[RP_COLUMNS,nCol,RC_WIDTH] )
  487.             ELSE
  488.                IF nLine == 1
  489.                   cLine := TRANSFORM(EVAL(aReportData[RP_COLUMNS,nCol,RC_EXP]),;
  490.                            aReportData[RP_COLUMNS,nCol,RC_PICT])
  491.                   cLine := PADR( cLine, aReportData[RP_COLUMNS,nCol,RC_WIDTH] )
  492.                ELSE
  493.                   cLine := SPACE( aReportData[RP_COLUMNS,nCol,RC_WIDTH])
  494.                ENDIF
  495.             ENDIF
  496.             // Add it to the existing report line
  497.             IF nCol > 1
  498.                aRecordToPrint[ nLine ] += " "
  499.             ENDIF
  500.             aRecordToPrint[ nLine ] += cLine
  501.          NEXT
  502.       NEXT
  503.  
  504.       // Determine if aRecordToPrint will fit on the current page
  505.       IF LEN( aRecordToPrint ) > nLinesLeft
  506.          // The record will not fit on the current page - will it fit on
  507.          // a full page?  If not, break it up and print it.
  508.          IF LEN( aRecordToPrint ) > nMaxLinesAvail
  509.             // This record is HUGE!  Break it up...
  510.             nLine := 1
  511.             DO WHILE nLine < LEN( aRecordToPrint )
  512.                PrintIt( SPACE(aReportData[RP_LMARGIN]) + aRecordToPrint[nLine] )
  513.                nLine++
  514.                nLinesLeft--
  515.                IF nLinesLeft == 0
  516.                   EjectPage()
  517.                   IF aReportData[ RP_PLAIN ]
  518.                      nLinesLeft := 1000
  519.                   ELSE
  520.                      ReportHeader()
  521.                   ENDIF
  522.                ENDIF
  523.             ENDDO
  524.          ELSE
  525.             EjectPage()
  526.             IF aReportData[ RP_PLAIN ]
  527.                nLinesLeft := 1000
  528.             ELSE
  529.                ReportHeader()
  530.             ENDIF
  531.             AEVAL( aRecordToPrint, ;
  532.                { | RecordLine | ;
  533.                  PrintIt( SPACE(aReportData[RP_LMARGIN])+ RecordLine ) ;
  534.                } ;
  535.             )
  536.             nLinesLeft -= LEN( aRecordToPrint )
  537.          ENDIF
  538.       ELSE
  539.          // Send aRecordToPrint to the output device, resetting nLinesLeft
  540.          AEVAL( aRecordToPrint, ;
  541.             { | RecordLine | ;
  542.               PrintIt( SPACE(aReportData[RP_LMARGIN])+ RecordLine ) ;
  543.             } ;
  544.          )
  545.          nLinesLeft -= LEN( aRecordToPrint )
  546.       ENDIF
  547.  
  548.       // Make sure it didn't hit the bottom margin
  549.       IF nLinesLeft == 0
  550.          EjectPage()
  551.          IF aReportData[ RP_PLAIN ]
  552.             nLinesLeft := 1000
  553.          ELSE
  554.             ReportHeader()
  555.          ENDIF
  556.       ENDIF
  557.  
  558.       // Tack on the spacing for double/triple/etc.
  559.       IF aReportData[ RP_SPACING ] > 1
  560.          IF nLinesLeft > aReportData[ RP_SPACING ] - 1
  561.             FOR nLine := 2 TO aReportData[ RP_SPACING ]
  562.                PrintIt()
  563.                nLinesLeft--
  564.             NEXT
  565.          ENDIF
  566.       ENDIF
  567.  
  568.    ENDIF    // Was this a summary report?
  569.  
  570.    RETURN
  571.  
  572.  
  573. /***
  574. *
  575. *  ReportHeader()
  576. *
  577. */
  578. STATIC PROCEDURE ReportHeader
  579.    LOCAL nLinesInHeader := 0
  580.    LOCAL aPageHeader    := {}
  581.    LOCAL nHeadingLength := aReportData[RP_WIDTH] - aReportData[RP_LMARGIN] - 30
  582.    LOCAL nCol, nLine, nMaxColLength, nGroup, cHeader
  583.    LOCAL nHeadLine            // lines in a single heading
  584.    LOCAL nRPageSize           // width of report after subtracting right margin
  585.    LOCAL aTempPgHeader        // temporary page header array
  586.  
  587.    nRPageSize := aReportData[RP_WIDTH] - aReportData[RP_RMARGIN]
  588.  
  589.    // Create the header and drop it into aPageHeader
  590.  
  591.    // Start with the heading
  592.    IF !aReportData[ RP_PLAIN ]           // If not a plain paper report, build
  593.       IF aReportData[RP_HEADING] == ""   // the heading
  594.          AADD( aPageHeader, "Page No." + STR(nPageNumber,6) )
  595.  
  596.       ELSE
  597.          aTempPgHeader := ParseHeader( aReportData[ RP_HEADING ], ;
  598.             Occurs( ";", aReportData[ RP_HEADING ] ) + 1 )
  599.  
  600.          FOR nLine := 1 TO LEN( aTempPgHeader )
  601.             // determine number of lines in header given current report dimensions
  602.             nLinesInHeader := MAX( XMLCOUNT( LTRIM( aTempPgHeader[ nLine ] ), ;
  603.                nHeadingLength ), 1 )
  604.         
  605.             // extract lines and add to array
  606.             FOR nHeadLine := 1 TO nLinesInHeader
  607.  
  608.                AADD( aPageHeader, SPACE( 15 ) + ;
  609.                   PADC( TRIM( XMEMOLINE( LTRIM( aTempPgHeader[ nLine ] ),;
  610.                   nHeadingLength, nHeadLine ) ), nHeadingLength ) )
  611.  
  612.             NEXT nHeadLine
  613.  
  614.          NEXT nLine
  615.          aPageHeader[ 1 ] := STUFF( aPageHeader[ 1 ], 1, 14, ;
  616.                                     "Page No." + STR(nPageNumber,6) )
  617.          
  618.       ENDIF
  619.       AADD( aPageHeader, DTOC(DATE()) )
  620.  
  621.    ENDIF
  622.  
  623.    // Tack on the actual header from the FRM
  624.    FOR nLine := 1 TO LEN( aReportData[RP_HEADER] )
  625.       // determine number of lines in header given current report dimensions
  626.       nLinesInHeader := MAX( XMLCOUNT( LTRIM( aReportData[RP_HEADER, ;
  627.             nLine ] ), nRPageSize ), 1 )
  628.         
  629.       // extract lines and add to array
  630.       FOR nHeadLine := 1 TO nLinesInHeader
  631.          cHeader := TRIM( XMEMOLINE( LTRIM( aReportData[ RP_HEADER, nLine ] ),;
  632.             nRPageSize, nHeadLine) )
  633.  
  634.          AADD( aPageHeader, SPACE( ( nRPageSize - aReportData[ RP_LMARGIN ] - ;
  635.             LEN( cHeader ) ) / 2 ) + cHeader )
  636.       NEXT nHeadLine
  637.  
  638.    NEXT nLine
  639.  
  640. #ifdef S87_COMPAT
  641.    // S87 compat.
  642.    AADD( aPageHeader, "" )
  643. #endif
  644.  
  645.    // Now add the column headings
  646.    nLinesInHeader := LEN( aPageHeader )
  647.  
  648.    // Determine the longest column header
  649.    nMaxColLength := 0
  650.    FOR nCol := 1 TO LEN( aReportData[ RP_COLUMNS ] )
  651.        nMaxColLength := MAX( LEN(aReportData[RP_COLUMNS,nCol,RC_HEADER]), ;
  652.                              nMaxColLength )
  653.    NEXT
  654.    FOR nCol := 1 TO LEN( aReportData[ RP_COLUMNS ] )
  655.       ASIZE( aReportData[RP_COLUMNS,nCol,RC_HEADER], nMaxColLength )
  656.    NEXT
  657.  
  658.    FOR nLine := 1 TO nMaxColLength
  659.       AADD( aPageHeader, "" )
  660.    NEXT
  661.  
  662.    FOR nCol := 1 TO LEN(aReportData[RP_COLUMNS])    // Cycle through the columns
  663.       FOR nLine := 1 TO nMaxColLength
  664.          IF nCol > 1
  665.             aPageHeader[ nLinesInHeader + nLine ] += " "
  666.          ENDIF
  667.          IF aReportData[RP_COLUMNS,nCol,RC_HEADER,nLine] == NIL
  668.             aPageHeader[ nLinesInHeader + nLine ] += ;
  669.                            SPACE( aReportData[RP_COLUMNS,nCol,RC_WIDTH] )
  670.          ELSE
  671.             IF aReportData[RP_COLUMNS,nCol,RC_TYPE] == "N"
  672.                aPageHeader[ nLinesInHeader + nLine ] += ;
  673.                            PADL(aReportData[RP_COLUMNS,nCol,RC_HEADER,nLine],;
  674.                            aReportData[RP_COLUMNS,nCol,RC_WIDTH])
  675.             ELSE
  676.                aPageHeader[ nLinesInHeader + nLine ] += ;
  677.                            PADR(aReportData[RP_COLUMNS,nCol,RC_HEADER,nLine],;
  678.                            aReportData[RP_COLUMNS,nCol,RC_WIDTH])
  679.             ENDIF
  680.          ENDIF
  681.       NEXT
  682.    NEXT
  683.  
  684.    // Insert the two blank lines between the heading and the actual data
  685.    AADD( aPageHeader, "" )
  686.    AADD( aPageHeader, "" )
  687.  
  688.    AEVAL( aPageHeader, { | HeaderLine | ;
  689.          PrintIt( SPACE(aReportData[RP_LMARGIN])+ HeaderLine ) } )
  690.  
  691.    // Set the page number and number of available lines
  692.    nPageNumber++
  693.     
  694.     // adjust the line count to account for Summer '87 behavior
  695.    nLinesLeft := aReportData[RP_LINES] - LEN( aPageHeader )
  696.    nMaxLinesAvail := aReportData[RP_LINES] - LEN( aPageHeader )
  697.  
  698.    RETURN
  699.  
  700. /***
  701. *  Occurs( <cSearch>, <cTarget> ) --> nCount
  702. *  Determine the number of times <cSearch> is found in <cTarget>
  703. *
  704. */
  705. STATIC FUNCTION Occurs( cSearch, cTarget )
  706.    LOCAL nPos, nCount := 0
  707.    DO WHILE !EMPTY( cTarget )
  708.       IF (nPos := AT( cSearch, cTarget )) != 0
  709.          nCount++
  710.          cTarget := SUBSTR( cTarget, nPos + 1 )
  711.       ELSE     
  712.          // End of string
  713.          cTarget := ""
  714.       ENDIF
  715.    ENDDO
  716.    RETURN nCount
  717.  
  718. /***
  719. *     MakeStr( <exp>, <cType> ) --> value
  720. *     Convert a value of any data type into string to add to the group header 
  721. */
  722. STATIC FUNCTION MakeAStr( uVar, cType )
  723.    LOCAL cString
  724.    DO CASE
  725.    CASE UPPER(cType) == "D"
  726.       cString := DTOC( uVar )
  727.  
  728.    CASE UPPER(cType) == "L"
  729.       cString := IF( uVar, "T", "F" )
  730.  
  731.    CASE UPPER(cType) == "N"
  732.       cString := STR( uVar )
  733.  
  734.    CASE UPPER(cType) == "C"
  735.       cString := uVar
  736.  
  737.    OTHERWISE
  738.       cString := "INVALID EXPRESSION"
  739.    ENDCASE
  740.    RETURN( cString )
  741.  
  742. /***
  743. *  PrintIt( <cString> )
  744. *  Print a string, THEN send a CRLF
  745. */
  746. STATIC PROCEDURE PrintIt( cString )
  747.  
  748.    IF cString == NIL
  749.       cString := ""
  750.    ELSE
  751. #ifdef S87_COMPAT
  752.      // prevents output of trailing space, also prevents wrapping of some
  753.      // lines when sent to screen or 80-column printer. Comment out this
  754.      // line for complete Summer 87 compatibility.
  755.      //cString := Trim( cString )
  756. #endif
  757.    ENDIF
  758.  
  759.    QQOUT( cString )
  760.    QOUT()
  761.  
  762.    RETURN
  763.  
  764. /***
  765. *
  766. *  EjectPage()
  767. *  Eject a page if the form feed option is set
  768. *
  769. */
  770. STATIC PROCEDURE EjectPage
  771.    IF lFormFeeds
  772.       EJECT
  773.    ENDIF
  774.    RETURN
  775.  
  776. /***
  777. *
  778. *  XMLCOUNT( <cString>, [<nLineLength>], [<nTabSize>], 
  779. *     [<lWrap>] ) --> nLineCount
  780. *
  781. */
  782. STATIC FUNCTION XMLCOUNT( cString, nLineLength, nTabSize, lWrap )
  783.    // Set defaults if none specified
  784.    nLineLength := IF( nLineLength == NIL, 79, nLineLength )
  785.    nTabSize := IF( nTabSize == NIL, 4, nTabSize )
  786.    lWrap := IF( lWrap == NIL, .T., .F. )
  787.  
  788.    IF nTabSize >= nLineLength
  789.       nTabSize := nLineLength - 1
  790.    ENDIF
  791.    RETURN( MLCOUNT( TRIM(cString), nLineLength, nTabSize, lWrap ) )
  792.  
  793.  
  794. /***
  795. *
  796. *  XMEMOLINE( <cString>, [<nLineLength>], [<nLineNumber>],
  797. *         [<nTabSize>], [<lWrap>] ) --> cLine
  798. *
  799. */
  800. STATIC FUNCTION XMEMOLINE( cString, nLineLength, nLineNumber, nTabSize, lWrap )
  801.  
  802.    // Set defaults if none specified
  803.    nLineLength := IF( nLineLength == NIL, 79, nLineLength )
  804.    nLineNumber := IF( nLineNumber == NIL, 1, nLineNumber )
  805.    nTabSize := IF( nTabSize == NIL, 4, nTabSize )
  806.    lWrap := IF( lWrap == NIL, .T., lWrap )
  807.  
  808.    IF nTabSize >= nLineLength
  809.       nTabSize := nLineLength - 1
  810.    ENDIF
  811.  
  812.    RETURN( MEMOLINE( cString, nLineLength, nLineNumber, nTabSize, lWrap ) )
  813.  
  814.