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