home *** CD-ROM | disk | FTP | other *** search
/ mail.altrad.com / 2015.02.mail.altrad.com.tar / mail.altrad.com / TEST / COMMERC_72_53OLD / commerc / PROGSOLD / MYREPORT.PRG < prev    next >
Text File  |  2014-04-02  |  58KB  |  1,885 lines
  1. //Programme: REPORT.PRG
  2. //Auteur...: R M ALCOCK
  3. //Date.....: 16:24:20  5/19/1992
  4. //Copyright: (c) 2002, R M ALCOCK, Tous droits réservés
  5. //Notes....: REPORT SYSTEM FOR ALASKA
  6. //
  7. //
  8.  
  9. #include "MYREPORT.CH"
  10. *PROCEDURE DUMMY
  11. STATIC aReportData, nPageNumber, nLinesLeft, aReportTotals
  12. STATIC aGroupTotals, lFirstPass, lFormFeeds, nMaxLinesAvail
  13.  
  14. // Declare file-wide statics for FRMBACK.PRG
  15. STATIC cExprBuff
  16. STATIC cOffsetsBuff
  17. STATIC cLengthsBuff
  18.  
  19. // File-wide static declarations for LABEL FORM
  20. // Label definition array
  21. STATIC aLabelData := {}
  22. STATIC aBandToPrint := {}
  23. STATIC cBlank := ""
  24. STATIC lOneMoreBand := .T.
  25. STATIC nCurrentCol  := 1            // The current column in the band
  26. *RETURN
  27.  
  28. /***
  29. *
  30. *  __ReportForm( <cFRMName>, [<lPrinter>], <cAltFile>,
  31. *         [<lNoConsole>], <bFor>, <bWhile>, <nNext>, <nRecord>,
  32. *         <lRest>, <lPlain>, [<cHeading>], [<lBEject>],
  33. *         [<lSummary>] )
  34. *
  35. */
  36. PROCEDURE __ReportForm( cFRMName, lPrinter, cAltFile, lNoConsole, bFor, ;
  37.                        bWhile, nNext, nRecord, lRest, lPlain, cHeading, ;
  38.                        lBEject, lSummary )
  39.  
  40.    LOCAL lPrintOn, lConsoleOn // Status of PRINTER and CONSOLE
  41.    LOCAL cExtraFile, lExtraState // Status of EXTRA
  42.    LOCAL nCol, nGroup
  43.    LOCAL xBreakVal, lBroke := .F.
  44.    LOCAL err
  45.  
  46.    LOCAL lAnyTotals
  47.    LOCAL lAnySubTotals
  48.  
  49.    // Resolve parameters
  50.    IF cFRMName == NIL
  51.       err := ErrorNew()
  52.       err:severity := ES_ERROR
  53.       err:genCode := EG_ARG
  54.       err:subSystem := "FRMLBL"
  55.       Eval(ErrorBlock(), err)
  56.    ELSE
  57.       IF AT( ".", cFRMName ) == 0
  58.          cFRMName := TRIM( cFRMName ) + ".FRM"
  59.       ENDIF
  60.    ENDIF
  61.  
  62. #ifdef OLDCODE
  63.    IF lPrinter == NIL
  64.      lPrinter   := .F.
  65.    ENDIF
  66. #endif
  67.  
  68.    IF cHeading == NIL
  69.      cHeading := ""
  70.    ENDIF
  71.  
  72.    // Set output devices
  73. #ifdef OLDCODE
  74.    lPrintOn   := SET( _SET_PRINTER, lPrinter )
  75.  
  76.    lConsoleOn := SET( _SET_CONSOLE, .F. )
  77.    SET( _SET_CONSOLE, ! ( lNoConsole .OR. !lConsoleOn ) )
  78. #endif
  79.  
  80.    lPrintOn   := IF( lPrinter,   SET( _SET_PRINTER, lPrinter ), ;
  81.                                    SET( _SET_PRINTER ) )
  82.  
  83.      lConsoleOn := IF( lNoConsole, SET( _SET_CONSOLE, .F.),       ;
  84.                                  SET( _SET_CONSOLE) )
  85.  
  86.    IF lPrinter                   // To the printer
  87.      lFormFeeds := .T.
  88.    ELSE
  89.      lFormFeeds := .F.
  90.    ENDIF
  91.  
  92.    IF (!Empty(cAltFile))            // To file
  93.      lExtraState := SET( _SET_EXTRA, .T. )
  94.      cExtraFile := SET( _SET_EXTRAFILE, cAltFile )
  95.    ENDIF
  96.  
  97.  
  98.    BEGIN SEQUENCE
  99.  
  100.          aReportData := __FrmLoad( cFRMName )  // Load the frm into an array
  101.          nMaxLinesAvail := aReportData[RP_LINES]
  102.  
  103.          // Modify aReportData based on the report parameters
  104. #ifdef OLDCODE
  105.          IF lSummary != NIL             // Set the summary only flag
  106. #else
  107.       IF lSummary == .T.             // Set the summary only flag
  108. #endif
  109.           aReportData[ RP_SUMMARY ] := lSummary
  110.          ENDIF
  111.          IF lBEject != NIL .AND. lBEject
  112.              aReportData[ RP_BEJECT ]  := .F.
  113.          ENDIF
  114.          IF lPlain                      // Set plain report flag
  115.            aReportData[ RP_PLAIN ]   := .T.
  116.            cHeading               := ""
  117.            lFormFeeds             := .F.
  118.          ENDIF
  119.          aReportData[ RP_HEADING ]    := cHeading
  120.  
  121.          // Add to the left margin if a SET MARGIN has been defined
  122.          // NOTE: uncommenting this line will cause REPORT FORM to respect
  123.          // SET MARGIN to screen/to file, but double the margin TO PRINT
  124.          // aReportData[ RP_LMARGIN ] += SET( _SET_MARGIN )
  125.  
  126.          nPageNumber := 1                  // Set the initial page number
  127.          lFirstPass  := .T.             // Set the first pass flag
  128.  
  129.          nLinesLeft  := aReportData[ RP_LINES ]
  130.  
  131. #ifdef S87_COMPAT
  132.         QOUT()        // output additional line on first page
  133.         nLinesLeft--
  134. #endif
  135.  
  136.          // Check to see if a "before report" eject, or TO FILE has been specified
  137.          IF aReportData[ RP_BEJECT ]
  138.           EjectPage()
  139.  
  140.          ENDIF
  141.  
  142.          // Generate the initial report header manually (in case there are no
  143.          // records that match the report scope)
  144.          ReportHeader()
  145.  
  146.          // Initialize aReportTotals to track both group and report totals, then
  147.          // set the column total elements to 0 if they are to be totaled, otherwise
  148.          // leave them NIL
  149.          aReportTotals := ARRAY( LEN(aReportData[RP_GROUPS]) + 1, ;
  150.                            LEN(aReportData[RP_COLUMNS]) )
  151.  
  152.          // Column total elements
  153.          FOR nCol := 1 TO LEN(aReportData[RP_COLUMNS])
  154.            IF aReportData[RP_COLUMNS,nCol,RC_TOTAL]
  155.              FOR nGroup := 1 TO LEN(aReportTotals)
  156.                 aReportTotals[nGroup,nCol] := 0
  157.              NEXT
  158.            ENDIF
  159.          NEXT
  160.  
  161.          // Initialize aGroupTotals as an array
  162.          aGroupTotals := ARRAY( LEN(aReportData[RP_GROUPS]) )
  163.  
  164.          // Execute the actual report based on matching records
  165.          DBEval( { || ExecuteReport() }, bFor, bWhile, nNext, nRecord, lRest )
  166.  
  167.          // Generate any totals that may have been identified
  168.          // Make a pass through all the groups
  169.          FOR nGroup := LEN(aReportData[RP_GROUPS]) TO 1 STEP -1
  170.  
  171.  
  172.            // make sure group has subtotals
  173.            lAnySubTotals := .F.
  174.            FOR nCol := 1 TO LEN(aReportData[RP_COLUMNS])
  175.              IF aReportData[RP_COLUMNS,nCol,RC_TOTAL]
  176.                 lAnySubTotals := .T.
  177.                 EXIT              // NOTE
  178.              ENDIF
  179.            NEXT
  180.  
  181.            IF !lAnySubTotals
  182.              LOOP                 // NOTE
  183.            ENDIF
  184.  
  185.  
  186.            // Check to see if we need to eject the page
  187.            IF nLinesLeft < 2
  188.              EjectPage()
  189.              IF aReportData[ RP_PLAIN ]
  190.                 nLinesLeft := 1000
  191.              ELSE
  192.                 ReportHeader()
  193.              ENDIF
  194.            ENDIF
  195.  
  196.            // Print the first line
  197.            PrintIt( SPACE(aReportData[RP_LMARGIN]) + ;
  198.                 IF(nGroup==1,NationMsg(_RF_SUBTOTAL),;
  199.                             NationMsg(_RF_SUBSUBTOTAL) ) )
  200.  
  201.            // Print the second line
  202.            QQOUT( SPACE(aReportData[RP_LMARGIN]) )
  203.            FOR nCol := 1 TO LEN(aReportData[RP_COLUMNS])
  204.              IF nCol > 1
  205.                 QQOUT( " " )
  206.              ENDIF
  207.              IF aReportData[RP_COLUMNS,nCol,RC_TOTAL]
  208.                 QQOUT( TRANSFORM(aReportTotals[nGroup+1,nCol], ;
  209.                   aReportData[RP_COLUMNS,nCol,RC_PICT]) )
  210.              ELSE
  211.                 QQOUT( SPACE(aReportData[RP_COLUMNS,nCol,RC_WIDTH]) )
  212.              ENDIF
  213.            NEXT
  214.  
  215.            // Send a cr/lf for the last line
  216.            QOUT()
  217.  
  218.          NEXT
  219.  
  220. #ifdef OLDCODE
  221.          // Generate the "Grand totals"
  222.          // Check to see if we need to eject the page
  223.          IF nLinesLeft < 2
  224.            EjectPage()
  225.            IF aReportData[ RP_PLAIN ]
  226.              nLinesLeft := 1000
  227.            ELSE
  228.              ReportHeader()
  229.            ENDIF
  230.          ENDIF
  231. #endif
  232.  
  233.          // Any report totals?
  234.          lAnyTotals := .F.
  235.          FOR nCol := 1 TO LEN(aReportData[RP_COLUMNS])
  236.            IF aReportData[RP_COLUMNS,nCol,RC_TOTAL]
  237.              lAnyTotals := .T.
  238.              EXIT
  239.            ENDIF
  240.          NEXT nCol
  241.  
  242.  
  243.          IF lAnyTotals
  244.  
  245. #ifndef OLDCODE
  246.         // Check to see if we need to eject the page
  247.         IF nLinesLeft < 2
  248.           EjectPage()
  249.           IF aReportData[ RP_PLAIN ]
  250.             nLinesLeft := 1000
  251.           ELSE
  252.             ReportHeader()
  253.           ENDIF
  254.         ENDIF
  255. #endif
  256.  
  257.             // Print the first line
  258.             PrintIt( SPACE(aReportData[RP_LMARGIN]) + NationMsg(_RF_TOTAL ) )
  259.  
  260.             // Print the second line
  261.             QQOUT( SPACE(aReportData[RP_LMARGIN]) )
  262.             FOR nCol := 1 TO LEN(aReportData[RP_COLUMNS])
  263.               IF nCol > 1
  264.                 QQOUT( " " )
  265.               ENDIF
  266.               IF aReportData[RP_COLUMNS,nCol,RC_TOTAL]
  267.                 QQOUT( TRANSFORM(aReportTotals[1,nCol], ;
  268.                    aReportData[RP_COLUMNS,nCol,RC_PICT]) )
  269.               ELSE
  270.                 QQOUT( SPACE(aReportData[RP_COLUMNS,nCol,RC_WIDTH]) )
  271.               ENDIF
  272.             NEXT nCol
  273.  
  274.             // Send a cr/lf for the last line
  275.             QOUT()
  276.  
  277.          ENDIF
  278.  
  279.          // Check to see if an "after report" eject, or TO FILE has been specified
  280.          IF aReportData[ RP_AEJECT ]
  281.           EjectPage()
  282.          ENDIF
  283.  
  284.  
  285.    RECOVER USING xBreakVal
  286.  
  287.         lBroke := .T.
  288.  
  289.    END SEQUENCE
  290.  
  291.  
  292.    // Clean up and leave
  293.    aReportData   := NIL          // Recover the space
  294.    aReportTotals  := NIL
  295.    aGroupTotals   := NIL
  296.    nPageNumber   := NIL
  297.    lFirstPass    := NIL
  298.    nLinesLeft    := NIL
  299.    lFormFeeds    := NIL
  300.    nMaxLinesAvail := NIL
  301.  
  302.    // clean up
  303.    SET( _SET_PRINTER, lPrintOn )    // Set the printer back to prior state
  304.    SET( _SET_CONSOLE, lConsoleOn )     // Set the console back to prior state
  305.  
  306.    IF (!Empty(cAltFile))            // Set extrafile back
  307.      SET( _SET_EXTRAFILE, cExtraFile )
  308.      SET( _SET_EXTRA, lExtraState )
  309.    ENDIF
  310.  
  311.    IF lBroke
  312.      // keep the break value going
  313.      BREAK xBreakVal
  314.    END
  315.  
  316.    RETURN
  317.  
  318. /***
  319. *  ExecuteReport()
  320. *  Executed by DBEVAL() for each record that matches record scope
  321. */
  322. STATIC PROCEDURE ExecuteReport
  323.    LOCAL aRecordHeader  := {}          // Header for the current record
  324.    LOCAL aRecordToPrint := {}          // Current record to print
  325.    LOCAL nCol                          // Counter for the column work
  326.    LOCAL nGroup                        // Counter for the group work
  327.    LOCAL lGroupChanged  := .F.         // Has any group changed?
  328.    LOCAL lEjectGrp := .F.              // Group eject indicator
  329.    LOCAL nMaxLines                     // Number of lines needed by record
  330.    LOCAL nLine                         // Counter for each record line
  331.    LOCAL cLine                         // Current line of text for parsing
  332.    LOCAL nLastElement                  // Last element pointer if record is
  333.  
  334.    LOCAL lAnySubTotals
  335.  
  336.    // Add to the main column totals
  337.    FOR nCol := 1 TO LEN(aReportData[RP_COLUMNS])
  338.       IF aReportData[RP_COLUMNS,nCol,RC_TOTAL]
  339.          // If this column should be totaled, do it
  340.          aReportTotals[ 1 ,nCol] += ;
  341.                   EVAL( aReportData[RP_COLUMNS,nCol,RC_EXP] )
  342.       ENDIF
  343.    NEXT
  344.  
  345.    // Determine if any of the groups have changed.  If so, add the appropriate
  346.    // line to aRecordHeader for totaling out the previous records
  347.    IF !lFirstPass                       // Don't bother first time through
  348.  
  349.       // Make a pass through all the groups
  350.       FOR nGroup := LEN(aReportData[RP_GROUPS]) TO 1 STEP -1
  351.  
  352.  
  353.        // make sure group has subtotals
  354.        lAnySubTotals := .F.
  355.        FOR nCol := 1 TO LEN(aReportData[RP_COLUMNS])
  356.          IF aReportData[RP_COLUMNS,nCol,RC_TOTAL]
  357.             lAnySubTotals := .T.
  358.             EXIT              // NOTE
  359.          ENDIF
  360.        NEXT
  361.  
  362. #ifndef OLDCODE
  363.        // retrieve group eject state from report form
  364.        IF ( nGroup == 1 )
  365.          lEjectGrp := aReportData[ RP_GROUPS, nGroup, RG_AEJECT ]
  366.        ENDIF
  367. #endif
  368.  
  369.        IF !lAnySubTotals
  370.          LOOP                 // NOTE
  371.        ENDIF
  372.  
  373.          //  For subgroup processing: check if group has been changed
  374.                IF MakeAStr(EVAL(aReportData[RP_GROUPS, 1, RG_EXP]),;
  375.                  aReportData[RP_GROUPS, 1, RG_TYPE]) != aGroupTotals[1]
  376.                       lGroupChanged  := .T.
  377.                ENDIF
  378.  
  379.          //  If this (sub)group has changed since the last record
  380.          IF lGroupChanged .OR. MakeAStr(EVAL(aReportData[RP_GROUPS,nGroup,RG_EXP]),;
  381.              aReportData[RP_GROUPS,nGroup,RG_TYPE]) != aGroupTotals[nGroup]
  382.  
  383.             AADD( aRecordHeader, IF(nGroup==1,NationMsg(_RF_SUBTOTAL),;
  384.                                               NationMsg(_RF_SUBSUBTOTAL)) )
  385.             AADD( aRecordHeader, "" )
  386.  
  387. #ifdef OLDCODE
  388.                 // retrieve group eject state from report form
  389.                 IF ( nGroup == 1 )
  390.                     lEjectGrp := aReportData[ RP_GROUPS, nGroup, RG_AEJECT ]
  391.                 ENDIF
  392. #endif
  393.  
  394.             // Cycle through the columns, adding either the group
  395.             // amount from aReportTotals or spaces wide enough for
  396.             // the non-totaled columns
  397.             FOR nCol := 1 TO LEN(aReportData[RP_COLUMNS])
  398.                IF aReportData[RP_COLUMNS,nCol,RC_TOTAL]
  399.                   aRecordHeader[ LEN(aRecordHeader) ] += ;
  400.                      TRANSFORM(aReportTotals[nGroup+1,nCol], ;
  401.                      aReportData[RP_COLUMNS,nCol,RC_PICT])
  402.                   // Zero out the group totals column from aReportTotals
  403.                   aReportTotals[nGroup+1,nCol] := 0
  404.                ELSE
  405.                   aRecordHeader[ LEN(aRecordHeader) ] += ;
  406.                         SPACE(aReportData[RP_COLUMNS,nCol,RC_WIDTH])
  407.                ENDIF
  408.                aRecordHeader[ LEN(aRecordHeader) ] += " "
  409.             NEXT
  410.             // Get rid of the extra space from the last column
  411.             aRecordHeader[LEN(aRecordHeader)] := ;
  412.                   LEFT( aRecordHeader[LEN(aRecordHeader)], ;
  413.                   LEN(aRecordHeader[LEN(aRecordHeader)]) - 1 )
  414.          ENDIF
  415.       NEXT
  416.  
  417.    ENDIF
  418.  
  419. #ifdef OLDCODE
  420.    lFirstPass = .F.
  421. #endif
  422.  
  423.     IF ( LEN( aRecordHeader ) > 0 ) .AND. lEjectGrp .AND. lGroupChanged
  424.         IF LEN( aRecordHeader ) > nLinesLeft
  425.             EjectPage()
  426.  
  427.             IF ( aReportData[ RP_PLAIN ] )
  428.                 nLinesLeft := 1000
  429.             ELSE
  430.                 ReportHeader()
  431.             ENDIF
  432.  
  433.         ENDIF
  434.  
  435.         AEVAL( aRecordHeader, { | HeaderLine | ;
  436.             PrintIt( SPACE( aReportData[ RP_LMARGIN ] ) + HeaderLine ) } )
  437.  
  438.         aRecordHeader := {}
  439.  
  440.         EjectPage()
  441.  
  442.         IF ( aReportData[ RP_PLAIN ] )
  443.             nLinesLeft := 1000
  444.  
  445.         ELSE
  446.             ReportHeader()
  447.  
  448.         ENDIF
  449.  
  450.     ENDIF
  451.  
  452.    // Add to aRecordHeader in the event that the group has changed and
  453.    // new group headers need to be generated
  454.  
  455.    // Cycle through the groups
  456.    FOR nGroup := 1 TO LEN(aReportData[RP_GROUPS])
  457.       // If the group has changed
  458.       IF MakeAStr(EVAL(aReportData[RP_GROUPS,nGroup,RG_EXP]),;
  459.             aReportData[RP_GROUPS,nGroup,RG_TYPE]) == aGroupTotals[nGroup]
  460.       ELSE
  461.          AADD( aRecordHeader, "" )   // The blank line
  462.  
  463. // page eject after group
  464. #ifndef OLDCODE
  465.          //  put CRFF after group
  466.          IF nGroup == 1 .AND. !lFirstPass .AND. !lAnySubTotals
  467.             IF lEjectGrp := aReportData[ RP_GROUPS, nGroup, RG_AEJECT ]
  468.                nLinesLeft  := 0
  469.             ENDIF
  470.          ENDIF
  471. #endif
  472.  
  473.          AADD( aRecordHeader, IF(nGroup==1,"** ","* ") +;
  474.                aReportData[RP_GROUPS,nGroup,RG_HEADER] + " " +;
  475.                MakeAStr(EVAL(aReportData[RP_GROUPS,nGroup,RG_EXP]), ;
  476.                aReportData[RP_GROUPS,nGroup,RG_TYPE]) )
  477.       ENDIF
  478.    NEXT
  479.  
  480. #ifndef OLDCODE
  481.    lFirstPass := .F.
  482. #endif
  483.  
  484.    // Is there anything in the record header?
  485.    IF LEN( aRecordHeader ) > 0
  486.       // Determine if aRecordHeader will fit on the current page.  If not,
  487.       // start a new header
  488.       IF LEN( aRecordHeader ) > nLinesLeft
  489.          EjectPage()
  490.          IF aReportData[ RP_PLAIN ]
  491.             nLinesLeft := 1000
  492.          ELSE
  493.             ReportHeader()
  494.          ENDIF
  495.       ENDIF
  496.  
  497.       // Send aRecordHeader to the output device, resetting nLinesLeft
  498.       AEVAL( aRecordHeader, { | HeaderLine | ;
  499.               PrintIt( SPACE(aReportData[RP_LMARGIN])+ HeaderLine ) } )
  500.  
  501.       nLinesLeft -= LEN( aRecordHeader )
  502.  
  503.       // Make sure it didn't hit the bottom margin
  504.       IF nLinesLeft == 0
  505.          EjectPage()
  506.          IF aReportData[ RP_PLAIN ]
  507.             nLinesLeft := 1000
  508.          ELSE
  509.             ReportHeader()
  510.          ENDIF
  511.       ENDIF
  512.    ENDIF
  513.  
  514.    // Add to the group totals
  515.    FOR nCol := 1 TO LEN(aReportData[RP_COLUMNS])
  516.       // If this column should be totaled, do it
  517.       IF aReportData[RP_COLUMNS,nCol,RC_TOTAL]
  518.          // Cycle through the groups
  519.          FOR nGroup := 1 TO LEN( aReportTotals ) - 1
  520.             aReportTotals[nGroup+1,nCol] += ;
  521.                EVAL( aReportData[RP_COLUMNS,nCol,RC_EXP] )
  522.          NEXT
  523.       ENDIF
  524.    NEXT
  525.  
  526.    // Reset the group expressions in aGroupTotals
  527.    FOR nGroup := 1 TO LEN(aReportData[RP_GROUPS])
  528.       aGroupTotals[nGroup] := MakeAStr(EVAL(aReportData[RP_GROUPS,nGroup,RG_EXP]),;
  529.                                     aReportData[RP_GROUPS,nGroup,RG_TYPE])
  530.    NEXT
  531.  
  532.    // Only run through the record detail if this is NOT a summary report
  533.    IF !aReportData[ RP_SUMMARY ]
  534.       // Determine the max number of lines needed by each expression
  535.      nMaxLines := 1
  536.       FOR nCol := 1 TO LEN(aReportData[RP_COLUMNS])
  537.                 
  538.          IF aReportData[RP_COLUMNS,nCol,RC_TYPE] $ "M"
  539.             nMaxLines := MAX(XMLCOUNT(EVAL(aReportData[RP_COLUMNS,nCol,RC_EXP]),;
  540.                          aReportData[RP_COLUMNS,nCol,RC_WIDTH]), nMaxLines)
  541.          ELSEIF aReportData[RP_COLUMNS,nCol,RC_TYPE] $ "C"
  542.             nMaxLines := MAX( XMLCOUNT( STRTRAN( EVAL( aReportData[RP_COLUMNS,nCol,RC_EXP]),;
  543.                          ";", CHR(13)+CHR(10)),;
  544.                          aReportData[RP_COLUMNS,nCol,RC_WIDTH]), nMaxLines)
  545.          ENDIF
  546.       NEXT
  547.  
  548.       // Size aRecordToPrint to the maximum number of lines it will need, then
  549.       // fill it with nulls
  550.       ASIZE( aRecordToPrint, nMaxLines )
  551.       AFILL( aRecordToPrint, "" )
  552.  
  553.       // Load the current record into aRecordToPrint
  554.       FOR nCol := 1 TO LEN(aReportData[RP_COLUMNS])
  555.          FOR nLine := 1 TO nMaxLines
  556.             // Check to see if it's a memo or character
  557.             IF aReportData[RP_COLUMNS,nCol,RC_TYPE] $ "CM"
  558.                //  Load the current line of the current column into cLine
  559.                //  with multi-lines per record ";"- method
  560.                IF aReportData[RP_COLUMNS,nCol,RC_TYPE] $ "C"
  561.                   cLine := XMEMOLINE( TRIM( STRTRAN( EVAL(aReportData[RP_COLUMNS,nCol,RC_EXP]),;
  562.                              ";", CHR(13)+CHR(10)) ),;
  563.                              aReportData[RP_COLUMNS,nCol,RC_WIDTH], nLine )
  564.                ELSE
  565.                   cLine := XMEMOLINE(TRIM(EVAL(aReportData[RP_COLUMNS,nCol,RC_EXP])),;
  566.                              aReportData[RP_COLUMNS,nCol,RC_WIDTH], nLine )
  567.                              ENDIF
  568.                cLine := PADR( cLine, aReportData[RP_COLUMNS,nCol,RC_WIDTH] )
  569.             ELSE
  570.                IF nLine == 1
  571.                   cLine := TRANSFORM(EVAL(aReportData[RP_COLUMNS,nCol,RC_EXP]),;
  572.                            aReportData[RP_COLUMNS,nCol,RC_PICT])
  573.                   cLine := PADR( cLine, aReportData[RP_COLUMNS,nCol,RC_WIDTH] )
  574.                ELSE
  575.                   cLine := SPACE( aReportData[RP_COLUMNS,nCol,RC_WIDTH])
  576.                ENDIF
  577.             ENDIF
  578.             // Add it to the existing report line
  579.             IF nCol > 1
  580.                aRecordToPrint[ nLine ] += " "
  581.             ENDIF
  582.             aRecordToPrint[ nLine ] += cLine
  583.          NEXT
  584.       NEXT
  585.  
  586.       // Determine if aRecordToPrint will fit on the current page
  587.       IF LEN( aRecordToPrint ) > nLinesLeft
  588.          // The record will not fit on the current page - will it fit on
  589.          // a full page?  If not, break it up and print it.
  590.          IF LEN( aRecordToPrint ) > nMaxLinesAvail
  591.             // This record is HUGE!  Break it up...
  592.             nLine := 1
  593.             DO WHILE nLine < LEN( aRecordToPrint )
  594.                PrintIt( SPACE(aReportData[RP_LMARGIN]) + aRecordToPrint[nLine] )
  595.                nLine++
  596.                nLinesLeft--
  597.                IF nLinesLeft == 0
  598.                   EjectPage()
  599.                   IF aReportData[ RP_PLAIN ]
  600.                      nLinesLeft := 1000
  601.                   ELSE
  602.                      ReportHeader()
  603.                   ENDIF
  604.                ENDIF
  605.             ENDDO
  606.          ELSE
  607.             EjectPage()
  608.             IF aReportData[ RP_PLAIN ]
  609.                nLinesLeft := 1000
  610.             ELSE
  611.                ReportHeader()
  612.             ENDIF
  613.             AEVAL( aRecordToPrint, ;
  614.                { | RecordLine | ;
  615.                  PrintIt( SPACE(aReportData[RP_LMARGIN])+ RecordLine ) ;
  616.                } ;
  617.             )
  618.             nLinesLeft -= LEN( aRecordToPrint )
  619.          ENDIF
  620.       ELSE
  621.          // Send aRecordToPrint to the output device, resetting nLinesLeft
  622.          AEVAL( aRecordToPrint, ;
  623.             { | RecordLine | ;
  624.               PrintIt( SPACE(aReportData[RP_LMARGIN])+ RecordLine ) ;
  625.             } ;
  626.          )
  627.          nLinesLeft -= LEN( aRecordToPrint )
  628.       ENDIF
  629.  
  630. #ifdef OLDCODE
  631.       // Make sure it didn't hit the bottom margin
  632.       IF nLinesLeft == 0
  633.          EjectPage()
  634.          IF aReportData[ RP_PLAIN ]
  635.             nLinesLeft := 1000
  636.          ELSE
  637.             ReportHeader()
  638.          ENDIF
  639.       ENDIF
  640. #endif
  641.  
  642.       // Tack on the spacing for double/triple/etc.
  643.       IF aReportData[ RP_SPACING ] > 1
  644.  
  645. /*  Double space problem in REPORT FORM at the bottom of the page  */
  646. #ifdef OLDCODE
  647.          IF nLinesLeft > aReportData[ RP_SPACING ] - 1
  648. #else
  649.          IF nLinesLeft >= aReportData[ RP_SPACING ] - 1
  650. #endif
  651.  
  652.             FOR nLine := 2 TO aReportData[ RP_SPACING ]
  653.                PrintIt()
  654.                nLinesLeft--
  655.             NEXT
  656.          ENDIF
  657.       ENDIF
  658.  
  659.    ENDIF    // Was this a summary report?
  660.  
  661.    RETURN
  662.  
  663.  
  664. /***
  665. *
  666. *  ReportHeader()
  667. *
  668. */
  669. STATIC PROCEDURE ReportHeader
  670.    LOCAL nLinesInHeader := 0
  671.    LOCAL aPageHeader    := {}
  672.    LOCAL nHeadingLength := aReportData[RP_WIDTH] - aReportData[RP_LMARGIN] - 30
  673.    LOCAL nCol, nLine, nMaxColLength, nGroup, cHeader
  674.    LOCAL nHeadLine            // lines in a single heading
  675.    LOCAL nRPageSize           // width of report after subtracting right margin
  676.    LOCAL aTempPgHeader        // temporary page header array
  677.    LOCAL nHeadSize
  678.  
  679.  
  680.    nRPageSize := aReportData[RP_WIDTH] - aReportData[RP_RMARGIN]
  681.  
  682.    //  Header width should be less then 255 characters.
  683.    nHeadSize := MIN (nRPageSize, 254)
  684.  
  685.    // Create the header and drop it into aPageHeader
  686.  
  687.    // Start with the heading
  688.    IF !aReportData[ RP_PLAIN ]           // If not a plain paper report, build
  689.       IF aReportData[RP_HEADING] == ""   // the heading
  690.          AADD( aPageHeader, NationMsg(_RF_PAGENO) + STR(nPageNumber,6) )
  691.  
  692.       ELSE
  693.          aTempPgHeader := ParseHeader( aReportData[ RP_HEADING ], ;
  694.             Occurs( ";", aReportData[ RP_HEADING ] ) + 1 )
  695.  
  696.          FOR nLine := 1 TO LEN( aTempPgHeader )
  697.             // determine number of lines in header given current report dimensions
  698.             nLinesInHeader := MAX( XMLCOUNT( LTRIM( aTempPgHeader[ nLine ] ), ;
  699.                nHeadingLength ), 1 )
  700.  
  701.             // extract lines and add to array
  702.             FOR nHeadLine := 1 TO nLinesInHeader
  703.  
  704.                AADD( aPageHeader, SPACE( 15 ) + ;
  705.                   PADC( TRIM( XMEMOLINE( LTRIM( aTempPgHeader[ nLine ] ),;
  706.                   nHeadingLength, nHeadLine ) ), nHeadingLength ) )
  707.  
  708.             NEXT nHeadLine
  709.  
  710.          NEXT nLine
  711.          aPageHeader[ 1 ] := STUFF( aPageHeader[ 1 ], 1, 14, ;
  712.                                     NationMsg(_RF_PAGENO) + STR(nPageNumber,6) )
  713.  
  714.       ENDIF
  715.       AADD( aPageHeader, DTOC(DATE()) )
  716.  
  717.    ENDIF
  718.  
  719.    // Tack on the actual header from the FRM
  720.    FOR nLine := 1 TO LEN( aReportData[RP_HEADER] )
  721.       // determine number of lines in header given current report dimensions
  722.  
  723.       nLinesInHeader := MAX( XMLCOUNT( LTRIM( aReportData[RP_HEADER, ;
  724.          nLine ] ), nHeadSize ), 1 )
  725.  
  726.       // extract lines and add to array
  727.       FOR nHeadLine := 1 TO nLinesInHeader
  728.  
  729.          cHeader := TRIM( XMEMOLINE( LTRIM( aReportData[ RP_HEADER, nLine ] ),;
  730.             nHeadSize, nHeadLine) )
  731.  
  732.          AADD( aPageHeader, SPACE( ( nRPageSize - aReportData[ RP_LMARGIN ] - ;
  733.             LEN( cHeader ) ) / 2 ) + cHeader )
  734.       NEXT nHeadLine
  735.  
  736.    NEXT nLine
  737.  
  738. #ifdef S87_COMPAT
  739.    // S87 compat.
  740.    AADD( aPageHeader, "" )
  741. #endif
  742.  
  743.    // Now add the column headings
  744.    nLinesInHeader := LEN( aPageHeader )
  745.  
  746.    // Determine the longest column header
  747.    nMaxColLength := 0
  748.    FOR nCol := 1 TO LEN( aReportData[ RP_COLUMNS ] )
  749.        nMaxColLength := MAX( LEN(aReportData[RP_COLUMNS,nCol,RC_HEADER]), ;
  750.                              nMaxColLength )
  751.    NEXT
  752.    FOR nCol := 1 TO LEN( aReportData[ RP_COLUMNS ] )
  753.       ASIZE( aReportData[RP_COLUMNS,nCol,RC_HEADER], nMaxColLength )
  754.    NEXT
  755.  
  756.    FOR nLine := 1 TO nMaxColLength
  757.       AADD( aPageHeader, "" )
  758.    NEXT
  759.  
  760.    FOR nCol := 1 TO LEN(aReportData[RP_COLUMNS])    // Cycle through the columns
  761.       FOR nLine := 1 TO nMaxColLength
  762.          IF nCol > 1
  763.             aPageHeader[ nLinesInHeader + nLine ] += " "
  764.          ENDIF
  765.          IF aReportData[RP_COLUMNS,nCol,RC_HEADER,nLine] == NIL
  766.             aPageHeader[ nLinesInHeader + nLine ] += ;
  767.                            SPACE( aReportData[RP_COLUMNS,nCol,RC_WIDTH] )
  768.          ELSE
  769.             IF aReportData[RP_COLUMNS,nCol,RC_TYPE] == "N"
  770.                aPageHeader[ nLinesInHeader + nLine ] += ;
  771.                            PADL(aReportData[RP_COLUMNS,nCol,RC_HEADER,nLine],;
  772.                            aReportData[RP_COLUMNS,nCol,RC_WIDTH])
  773.             ELSE
  774.                aPageHeader[ nLinesInHeader + nLine ] += ;
  775.                            PADR(aReportData[RP_COLUMNS,nCol,RC_HEADER,nLine],;
  776.                            aReportData[RP_COLUMNS,nCol,RC_WIDTH])
  777.             ENDIF
  778.          ENDIF
  779.       NEXT
  780.    NEXT
  781.  
  782.    // Insert the two blank lines between the heading and the actual data
  783.    AADD( aPageHeader, "" )
  784.    AADD( aPageHeader, "" )
  785.    AEVAL( aPageHeader, { | HeaderLine | ;
  786.          PrintIt( SPACE(aReportData[RP_LMARGIN])+ HeaderLine ) } )
  787.  
  788.    // Set the page number and number of available lines
  789.    nPageNumber++
  790.  
  791.     // adjust the line count to account for Summer '87 behavior
  792.    nLinesLeft := aReportData[RP_LINES] - LEN( aPageHeader )
  793.    nMaxLinesAvail := aReportData[RP_LINES] - LEN( aPageHeader )
  794.  
  795.    RETURN
  796.  
  797. /***
  798. *  Occurs( <cSearch>, <cTarget> ) --> nCount
  799. *  Determine the number of times <cSearch> is found in <cTarget>
  800. *
  801. */
  802. STATIC FUNCTION Occurs( cSearch, cTarget )
  803.    LOCAL nPos, nCount := 0
  804.    DO WHILE !EMPTY( cTarget )
  805.       IF (nPos := AT( cSearch, cTarget )) != 0
  806.          nCount++
  807.          cTarget := SUBSTR( cTarget, nPos + 1 )
  808.       ELSE
  809.          // End of string
  810.          cTarget := ""
  811.       ENDIF
  812.    ENDDO
  813.    RETURN nCount
  814.  
  815. /***
  816. *     MakeStr( <exp>, <cType> ) --> value
  817. *     Convert a value of any data type into string to add to the group header
  818. */
  819. STATIC FUNCTION MakeAStr( uVar, cType )
  820.    LOCAL cString
  821.    DO CASE
  822.    CASE UPPER(cType) == "D"
  823.       cString := DTOC( uVar )
  824.  
  825.    CASE UPPER(cType) == "L"
  826.       cString := IF( uVar, "T", "F" )
  827.  
  828.    CASE UPPER(cType) == "N"
  829.       cString := STR( uVar )
  830.  
  831.    CASE UPPER(cType) == "C"
  832.       cString := uVar
  833.  
  834.    OTHERWISE
  835.       cString := "INVALID EXPRESSION"
  836.    ENDCASE
  837.    RETURN( cString )
  838.  
  839. /***
  840. *  PrintIt( <cString> )
  841. *  Print a string, THEN send a CRLF
  842. */
  843. STATIC PROCEDURE PrintIt( cString )
  844.  
  845.    IF cString == NIL
  846.       cString := ""
  847.    ELSE
  848. #ifdef S87_COMPAT
  849.      // prevents output of trailing space, also prevents wrapping of some
  850.      // lines when sent to screen or 80-column printer. Comment out this
  851.      // line for complete Summer 87 compatibility.
  852.      //cString := Trim( cString )
  853. #endif
  854.    ENDIF
  855.  
  856.    QQOUT( cString )
  857.    QOUT()
  858.  
  859.    RETURN
  860.  
  861. /***
  862. *
  863. *  EjectPage()
  864. *  Eject a page if the form feed option is set
  865. *
  866. */
  867. STATIC PROCEDURE EjectPage
  868.    IF lFormFeeds
  869.       EJECT
  870.    ENDIF
  871.    RETURN
  872.  
  873. /***
  874. *
  875. *  XMLCOUNT( <cString>, [<nLineLength>], [<nTabSize>],
  876. *     [<lWrap>] ) --> nLineCount
  877. *
  878. */
  879. STATIC FUNCTION XMLCOUNT( cString, nLineLength, nTabSize, lWrap )
  880.    // Set defaults if none specified
  881.    nLineLength := IF( nLineLength == NIL, 79, nLineLength )
  882.    nTabSize := IF( nTabSize == NIL, 4, nTabSize )
  883.    lWrap := IF( lWrap == NIL, .T., .F. )
  884.  
  885.    IF nTabSize >= nLineLength
  886.       nTabSize := nLineLength - 1
  887.    ENDIF
  888.    RETURN( MLCOUNT( TRIM(cString), nLineLength, nTabSize, lWrap ) )
  889.  
  890.  
  891. /***
  892. *
  893. *  XMEMOLINE( <cString>, [<nLineLength>], [<nLineNumber>],
  894. *         [<nTabSize>], [<lWrap>] ) --> cLine
  895. *
  896. */
  897. STATIC FUNCTION XMEMOLINE( cString, nLineLength, nLineNumber, nTabSize, lWrap )
  898.  
  899.    // Set defaults if none specified
  900.    nLineLength := IF( nLineLength == NIL, 79, nLineLength )
  901.    nLineNumber := IF( nLineNumber == NIL, 1, nLineNumber )
  902.    nTabSize := IF( nTabSize == NIL, 4, nTabSize )
  903.    lWrap := IF( lWrap == NIL, .T., lWrap )
  904.  
  905.    IF nTabSize >= nLineLength
  906.       nTabSize := nLineLength - 1
  907.    ENDIF
  908.  
  909.    RETURN( MEMOLINE( cString, nLineLength, nLineNumber, nTabSize, lWrap ) )
  910.    
  911.    
  912.    
  913.    /***
  914. *
  915. *  Frmback.prg
  916. *
  917. *  Create a report array from a (.frm) file
  918. *
  919. *  Copyright (c) 1990-1993, Computer Associates International, Inc.
  920. *  All rights reserved.
  921. *
  922. *  Compile: /m /n /w
  923. *
  924. */
  925.  
  926. // Definitions for buffer sizes
  927. #define  SIZE_FILE_BUFF             1990       // Size of report file
  928. #define  SIZE_LENGTHS_BUFF          110
  929. #define  SIZE_OFFSETS_BUFF          110
  930. #define  SIZE_EXPR_BUFF             1440
  931. #define  SIZE_FIELDS_BUFF           300
  932. #define  SIZE_PARAMS_BUFF           24
  933.  
  934. // Definitions for offsets into the FILE_BUFF string
  935. #define  LENGTHS_OFFSET             5          // Start of expression length array
  936. #define  OFFSETS_OFFSET             115        // Start of expression position array
  937. #define  EXPR_OFFSET                225        // Start of expression data area
  938. #define  FIELDS_OFFSET              1665       // Start of report columns (fields)
  939. #define  PARAMS_OFFSET              1965       // Start of report parameters block
  940.  
  941. // These are offsets into the FIELDS_BUFF string to actual values
  942. // Values are added to a block offset FLD_OFFSET that is moved in
  943. // increments of 12
  944. #define  FIELD_WIDTH_OFFSET         1
  945. #define  FIELD_TOTALS_OFFSET        6
  946. #define  FIELD_DECIMALS_OFFSET      7
  947.  
  948. // These are offsets into FIELDS_BUFF which are used to 'point' into
  949. // the EXPR_BUFF string which contains the textual data
  950. #define  FIELD_CONTENT_EXPR_OFFSET  9
  951. #define  FIELD_HEADER_EXPR_OFFSET   11
  952.  
  953. // These are actual offsets into the PARAMS_BUFF string which
  954. // are used to 'point' into the EXPR_BUFF string
  955. #define  PAGE_HDR_OFFSET            1
  956. #define  GRP_EXPR_OFFSET            3
  957. #define  SUB_EXPR_OFFSET            5
  958. #define  GRP_HDR_OFFSET             7
  959. #define  SUB_HDR_OFFSET             9
  960.  
  961. // These are actual offsets into the PARAMS_BUFF string to actual values
  962. #define  PAGE_WIDTH_OFFSET          11
  963. #define  LNS_PER_PAGE_OFFSET        13
  964. #define  LEFT_MRGN_OFFSET           15
  965. #define  RIGHT_MGRN_OFFSET          17
  966. #define  COL_COUNT_OFFSET           19
  967. #define  DBL_SPACE_OFFSET           21
  968. #define  SUMMARY_RPT_OFFSET         22
  969. #define  PE_OFFSET                  23
  970. #define  OPTION_OFFSET              24
  971.  
  972. // File error definitions
  973. #define  F_OK                       0          // No error
  974. #define  F_EMPTY                   -3          // File is empty
  975. #define  F_ERROR                   -1          // Some kind of error
  976. #define  F_NOEXIST                  2          // File does not exist
  977.  
  978.  
  979. /***
  980. *
  981. *  __FrmLoad( cFrmFile ) --> aReport
  982. *  Reads a report (.frm) file and creates a report array
  983. *
  984. *  Notes:
  985. *
  986. *      1.   Report file name has extension.
  987. *      2.   File error number placed in nFileError
  988. *      3.   Offsets start at 1. Offsets are into a Clipper string, 1 to 1990
  989. *      4.   The offsets mentioned in these notes are actual DOS FILE offsets,
  990. *           not like the offsets declared in the body of FrmLoad()
  991. *           which are Clipper STRING offsets.
  992. *      5.   Report file length is 7C6h (1990d) bytes.
  993. *      6.   Expression length array starts at 04h (4d) and can
  994. *           contain upto 55 short (2 byte) numbers.
  995. *      7.   Expression offset index array starts at 72h (114d) and
  996. *           can contain upto 55 short (2 byte) numbers.
  997. *      8.   Expression area starts at offset E0h (224d).
  998. *      9.   Expression area length is 5A0h (1440d).
  999. *     10.   Expressions in expression area are null terminated.
  1000. *     11.   Field expression area starts at offset 680h (1664d).
  1001. *     12.   Field expressions (column definition) are null terminated.
  1002. *     13.   Field expression area can contain upto 25 12-byte blocks.
  1003. */
  1004.  
  1005. /***
  1006. *
  1007. *  __FrmLoad( <cFrmFile> ) --> aReport
  1008. *
  1009. */
  1010. FUNCTION __FrmLoad( cFrmFile )
  1011.    LOCAL cFieldsBuff
  1012.    LOCAL cParamsBuff
  1013.    LOCAL nFieldOffset   := 0
  1014.    LOCAL cFileBuff      := SPACE(SIZE_FILE_BUFF)
  1015.    LOCAL cGroupExp      := SPACE(200)
  1016.    LOCAL cSubGroupExp   := SPACE(200)
  1017.    LOCAL nColCount      := 0        // Number of columns in report
  1018.    LOCAL nCount
  1019.    LOCAL nFrmHandle                 // (.frm) file handle
  1020.    LOCAL nBytesRead                 // Read/write and content record counter
  1021.    LOCAL nPointer       := 0        // Points to an offset into EXPR_BUFF string
  1022.    LOCAL nFileError                 // Contains current file error
  1023.    LOCAL cOptionByte                // Contains option byte
  1024.  
  1025.    LOCAL aReport[ RP_COUNT ]        // Create report array
  1026.    LOCAL err                        // error object
  1027.  
  1028.    LOCAL cDefPath          // contents of SET DEFAULT string
  1029.    LOCAL aPaths            // array of paths
  1030.    LOCAL nPathIndex := 0   // iteration counter
  1031.  
  1032.    LOCAL s, paths
  1033.    LOCAL i
  1034.     LOCAL aHeader                // temporary storage for report form headings
  1035.     LOCAL nHeaderIndex        // index into temporary header array
  1036.  
  1037.    // Initialize STATIC buffer values
  1038.    cLengthsBuff  := ""
  1039.    cOffsetsBuff  := ""
  1040.    cExprBuff     := ""
  1041.  
  1042.    // Default report values
  1043.    aReport[ RP_HEADER ]    := {}
  1044.    aReport[ RP_WIDTH ]     := 80
  1045.    aReport[ RP_LMARGIN ]   := 8
  1046.    aReport[ RP_RMARGIN ]   := 0
  1047.    aReport[ RP_LINES ]     := 58
  1048.    aReport[ RP_SPACING ]   := 1
  1049.    aReport[ RP_BEJECT ]    := .T.
  1050.    aReport[ RP_AEJECT ]    := .F.
  1051.    aReport[ RP_PLAIN ]     := .F.
  1052.    aReport[ RP_SUMMARY ]   := .F.
  1053.    aReport[ RP_COLUMNS ]   := {}
  1054.    aReport[ RP_GROUPS ]    := {}
  1055.    aReport[ RP_HEADING ]   := ""
  1056.  
  1057.    // Open the report file
  1058.    nFrmHandle := FOPEN( cFrmFile )
  1059.  
  1060.    IF ( !EMPTY( nFileError := FERROR() ) ) .AND. !( "\" $ cFrmFile .OR. ":" $ cFrmFile )
  1061.  
  1062.       // Search through default path; attempt to open report file
  1063.       cDefPath := SET( _SET_DEFAULT ) + ";" + SET( _SET_PATH )
  1064.       cDefPath := STRTRAN( cDefPath, ",", ";" )
  1065.       aPaths := ListAsArray( cDefPath, ";" )
  1066.  
  1067.       FOR nPathIndex := 1 TO LEN( aPaths )
  1068.          nFrmHandle := FOPEN( aPaths[ nPathIndex ] + "\" + cFrmFile )
  1069.          // if no error is reported, we have our report file
  1070.          IF EMPTY( nFileError := FERROR() )
  1071.             EXIT
  1072.  
  1073.          ENDIF
  1074.  
  1075.       NEXT nPathIndex
  1076.  
  1077.    ENDIF
  1078.  
  1079.    // File error
  1080.    IF nFileError != F_OK
  1081.       err := ErrorNew()
  1082.       err:severity := ES_ERROR
  1083.       err:genCode := EG_OPEN
  1084.       err:subSystem := "FRMLBL"
  1085.       err:osCode := nFileError
  1086.       err:filename := cFrmFile
  1087.       Eval(ErrorBlock(), err)
  1088.    ENDIF
  1089.  
  1090.    // OPEN ok?
  1091.    IF nFileError = F_OK
  1092.  
  1093.       // Go to START of report file
  1094.       FSEEK(nFrmHandle, 0)
  1095.  
  1096.       // SEEK ok?
  1097.       nFileError = FERROR()
  1098.       IF nFileError = F_OK
  1099.  
  1100.          // Read entire file into process buffer
  1101.          nBytesRead = FREAD(nFrmHandle, @cFileBuff, SIZE_FILE_BUFF)
  1102.  
  1103.          // READ ok?
  1104.          IF nBytesRead = 0
  1105.             nFileError = F_EMPTY        // file is empty
  1106.          ELSE
  1107.             nFileError = FERROR()       // check for DOS errors
  1108.          ENDIF
  1109.  
  1110.          IF nFileError = F_OK
  1111.  
  1112.             // Is this a .FRM type file (2 at start and end of file)
  1113.             IF BIN2W(SUBSTR(cFileBuff, 1, 2)) = 2 .AND.;
  1114.               BIN2W(SUBSTR(cFileBuff, SIZE_FILE_BUFF - 1, 2)) = 2
  1115.  
  1116.                nFileError = F_OK
  1117.             ELSE
  1118.                nFileError = F_ERROR
  1119.             ENDIF
  1120.  
  1121.          ENDIF
  1122.  
  1123.       ENDIF
  1124.  
  1125.       // Close file
  1126.       IF !FCLOSE(nFrmHandle)
  1127.          nFileError = FERROR()
  1128.       ENDIF
  1129.  
  1130.    ENDIF
  1131.  
  1132. // File existed, was opened and read ok and is a .FRM file
  1133. IF nFileError = F_OK
  1134.  
  1135.    // Fill processing buffers
  1136.    cLengthsBuff = SUBSTR(cFileBuff, LENGTHS_OFFSET, SIZE_LENGTHS_BUFF)
  1137.    cOffsetsBuff = SUBSTR(cFileBuff, OFFSETS_OFFSET, SIZE_OFFSETS_BUFF)
  1138.    cExprBuff    = SUBSTR(cFileBuff, EXPR_OFFSET, SIZE_EXPR_BUFF)
  1139.    cFieldsBuff  = SUBSTR(cFileBuff, FIELDS_OFFSET, SIZE_FIELDS_BUFF)
  1140.    cParamsBuff  = SUBSTR(cFileBuff, PARAMS_OFFSET, SIZE_PARAMS_BUFF)
  1141.  
  1142.  
  1143.    // Process report attributes
  1144.    // Report width
  1145.    aReport[ RP_WIDTH ]   := BIN2W(SUBSTR(cParamsBuff, PAGE_WIDTH_OFFSET, 2))
  1146.  
  1147.    // Lines per page
  1148.    aReport[ RP_LINES ]   := BIN2W(SUBSTR(cParamsBuff, LNS_PER_PAGE_OFFSET, 2))
  1149.  
  1150.    // Page offset (left margin)
  1151.    aReport[ RP_LMARGIN ] := BIN2W(SUBSTR(cParamsBuff, LEFT_MRGN_OFFSET, 2))
  1152.  
  1153.    // Page right margin (not used)
  1154.    aReport[ RP_RMARGIN ] := BIN2W(SUBSTR(cParamsBuff, RIGHT_MGRN_OFFSET, 2))
  1155.  
  1156.    nColCount  = BIN2W(SUBSTR(cParamsBuff, COL_COUNT_OFFSET, 2))
  1157.  
  1158.    // Line spacing
  1159.    // Spacing is 1, 2, or 3
  1160.    aReport[ RP_SPACING ] := IF(SUBSTR(cParamsBuff, ;
  1161.     DBL_SPACE_OFFSET, 1) $ "YyTt", 2, 1)
  1162.  
  1163.    // Summary report flag
  1164.    aReport[ RP_SUMMARY ] := IF(SUBSTR(cParamsBuff, ;
  1165.     SUMMARY_RPT_OFFSET, 1) $ "YyTt", .T., .F.)
  1166.  
  1167.    // Process report eject and plain attributes option byte
  1168.    cOptionByte = ASC(SUBSTR(cParamsBuff, OPTION_OFFSET, 1))
  1169.  
  1170.    IF INT(cOptionByte / 4) = 1
  1171.       aReport[ RP_PLAIN ] := .T.          // Plain page
  1172.       cOptionByte -= 4
  1173.    ENDIF
  1174.  
  1175.    IF INT(cOptionByte / 2) = 1
  1176.       aReport[ RP_AEJECT ] := .T.         // Page eject after report
  1177.       cOptionByte -= 2
  1178.    ENDIF
  1179.  
  1180.    IF INT(cOptionByte / 1) = 1
  1181.       aReport[ RP_BEJECT ] := .F.         // Page eject before report
  1182.       cOptionByte -= 1
  1183.    ENDIF
  1184.  
  1185.    // Page heading, report title
  1186.    nPointer = BIN2W(SUBSTR(cParamsBuff, PAGE_HDR_OFFSET, 2))
  1187.  
  1188.     // Retrieve the header stored in the .FRM file
  1189.     nHeaderIndex := 4
  1190.    aHeader := ParseHeader( GetExpr( nPointer ), nHeaderIndex )
  1191.  
  1192.     // certain that we have retrieved all heading entries from the .FRM file, we
  1193.     // now retract the empty headings
  1194.     DO WHILE ( nHeaderIndex > 0 )
  1195.         IF ! EMPTY( aHeader[ nHeaderIndex ] )
  1196.             EXIT
  1197.         ENDIF
  1198.         nHeaderIndex--
  1199.     ENDDO
  1200.  
  1201.     aReport[ RP_HEADER ] := IIF( EMPTY( nHeaderIndex ) , {}, ;
  1202.         ASIZE( aHeader, nHeaderIndex ) )
  1203.  
  1204.    // Process Groups
  1205.    // Group
  1206.    nPointer = BIN2W(SUBSTR(cParamsBuff, GRP_EXPR_OFFSET, 2))
  1207.  
  1208.    IF !EMPTY(cGroupExp := GetExpr( nPointer ))
  1209.  
  1210.       // Add a new group array
  1211.       AADD( aReport[ RP_GROUPS ], ARRAY( RG_COUNT ))
  1212.  
  1213.       // Group expression
  1214.       aReport[ RP_GROUPS ][1][ RG_TEXT ] := cGroupExp
  1215.       aReport[ RP_GROUPS ][1][ RG_EXP ] := &( "{ || " + cGroupExp + "}" )
  1216.       IF USED()
  1217.          aReport[ RP_GROUPS ][1][ RG_TYPE ] := ;
  1218.                         VALTYPE( EVAL( aReport[ RP_GROUPS ][1][ RG_EXP ] ) )
  1219.       ENDIF
  1220.  
  1221.       // Group header
  1222.       nPointer = BIN2W(SUBSTR(cParamsBuff, GRP_HDR_OFFSET, 2))
  1223.       aReport[ RP_GROUPS ][1][ RG_HEADER ] := GetExpr( nPointer )
  1224.  
  1225.       // Page eject after group
  1226.       aReport[ RP_GROUPS ][1][ RG_AEJECT ] := IF(SUBSTR(cParamsBuff, ;
  1227.       PE_OFFSET, 1) $ "YyTt", .T., .F.)
  1228.  
  1229.    ENDIF
  1230.  
  1231.    // Subgroup
  1232.    nPointer = BIN2W(SUBSTR(cParamsBuff, SUB_EXPR_OFFSET, 2))
  1233.  
  1234.    IF !EMPTY(cSubGroupExp := GetExpr( nPointer ))
  1235.  
  1236.       // Add new group array
  1237.       AADD( aReport[ RP_GROUPS ], ARRAY( RG_COUNT ))
  1238.  
  1239.       // Subgroup expression
  1240.       aReport[ RP_GROUPS ][2][ RG_TEXT ] := cSubGroupExp
  1241.       aReport[ RP_GROUPS ][2][ RG_EXP ] := &( "{ || " + cSubGroupExp + "}" )
  1242.       IF USED()
  1243.          aReport[ RP_GROUPS ][2][ RG_TYPE ] := ;
  1244.                         VALTYPE( EVAL( aReport[ RP_GROUPS ][2][ RG_EXP ] ) )
  1245.       ENDIF
  1246.  
  1247.       // Subgroup header
  1248.       nPointer = BIN2W(SUBSTR(cParamsBuff, SUB_HDR_OFFSET, 2))
  1249.       aReport[ RP_GROUPS ][2][ RG_HEADER ] := GetExpr( nPointer )
  1250.  
  1251.       // Page eject after subgroup
  1252.       aReport[ RP_GROUPS ][2][ RG_AEJECT ] := .F.
  1253.  
  1254.    ENDIF
  1255.  
  1256.    // Process columns
  1257.    nFieldOffset := 12      // dBASE skips first 12 byte fields block.
  1258.    FOR nCount := 1 to nColCount
  1259.  
  1260.       AADD( aReport[ RP_COLUMNS ], GetColumn( cFieldsBuff, @nFieldOffset ) )
  1261.  
  1262.    NEXT nCount
  1263.  
  1264. ENDIF
  1265.  
  1266. RETURN aReport
  1267.  
  1268. /***
  1269. *
  1270. *  ParseHeader( <cHeaderString>, <nFields> ) --> aPageHeader
  1271. *
  1272. *    Parse report header (title) field from .FRM and populate page header
  1273. *    array. Processing is complicated somewhat by varying .FRM storage
  1274. *  formats of dBASE III+ and CA-Clipper. Although similar to ListAsArray(),
  1275. *    this function also accounts for fixed-length strings.
  1276. *
  1277. */
  1278. FUNCTION ParseHeader( cHeaderString, nFields )
  1279.     LOCAL cItem
  1280.     LOCAL nItemCount := 0
  1281.     LOCAL aPageHeader := {}
  1282.    LOCAL nHeaderLen := 254
  1283.     LOCAL nPos
  1284.  
  1285.     DO WHILE ( ++nItemCount <= nFields )
  1286.  
  1287.         cItem := SUBSTR( cHeaderString, 1, nHeaderLen )
  1288.  
  1289.         // check for explicit delimiter
  1290.         nPos := AT( ";", cItem )
  1291.  
  1292.         IF ! EMPTY( nPos )
  1293.             // delimiter present
  1294.             AADD( aPageHeader, SUBSTR( cItem, 1, nPos - 1 ) )
  1295.         ELSE
  1296.             IF EMPTY( cItem )
  1297.                 // empty string for S87 and 5.0 compatibility
  1298.                 AADD( aPageHeader, "" )
  1299.             ELSE
  1300.                 // exception
  1301.                 AADD( aPageHeader, cItem )
  1302.  
  1303.             ENDIF
  1304.             // empty or not, we jump past the field
  1305.             nPos := nHeaderLen
  1306.         ENDIF
  1307.  
  1308.         cHeaderString := SUBSTR( cHeaderString, nPos + 1 )
  1309.  
  1310.     ENDDO
  1311.  
  1312.     RETURN( aPageHeader )
  1313.  
  1314. /***
  1315. *  GetExpr( nPointer ) --> cString
  1316. *
  1317. *  Reads an expression from EXPR_BUFF via the OFFSETS_BUFF and returns
  1318. *  a pointer to offset contained in OFFSETS_BUFF that in turn points
  1319. *  to an expression located in the EXPR_BUFF string.
  1320. *
  1321. *  Notes:
  1322. *
  1323. *     1. The expression is empty if:
  1324. *         a. Passed pointer is equal to 65535
  1325. *         b. Character following character pointed to by pointer is CHR(0)
  1326. *
  1327. */
  1328. STATIC FUNCTION GetExpr( nPointer )
  1329.    LOCAL nExprOffset   := 0
  1330.    LOCAL nExprLength   := 0
  1331.    LOCAL nOffsetOffset := 0
  1332.    LOCAL cString := ""
  1333.  
  1334.    // Stuff for dBASE compatability.
  1335.    IF nPointer != 65535
  1336.  
  1337.       // Convert DOS FILE offset to CLIPPER string offset
  1338.       nPointer++
  1339.  
  1340.       // Calculate offset into OFFSETS_BUFF
  1341.       IF nPointer > 1
  1342.          nOffsetOffset = (nPointer * 2) - 1
  1343.       ENDIF
  1344.  
  1345.       nExprOffset = BIN2W(SUBSTR(cOffsetsBuff, nOffsetOffset, 2))
  1346.       nExprLength = BIN2W(SUBSTR(cLengthsBuff, nOffsetOffset, 2))
  1347.  
  1348.       // EXPR_OFFSET points to a NULL, so add one (+1) to get the string
  1349.       // and subtract one (-1) from EXPR_LENGTH for correct length
  1350.  
  1351.       nExprOffset++
  1352.       nExprLength--
  1353.  
  1354.       // Extract string
  1355.       cString = SUBSTR(cExprBuff, nExprOffset, nExprLength)
  1356.  
  1357.       // dBASE does this so we must do it too
  1358.       // Character following character pointed to by pointer is NULL
  1359.       IF CHR(0) == SUBSTR(cString, 1, 1) .AND. LEN(SUBSTR(cString,1,1)) = 1
  1360.          cString = ""
  1361.       ENDIF
  1362.    ENDIF
  1363.  
  1364.    RETURN (cString)
  1365.  
  1366.  
  1367. /***
  1368. *  GetColumn( <cFieldBuffer>, @<nOffset> ) --> aColumn
  1369. *
  1370. *  Get a COLUMN element from FIELDS_BUFF string using nOffset to point to
  1371. *  the current FIELDS_OFFSET block.
  1372. *
  1373. *  Notes:
  1374. *     1. The Header or Contents expressions are empty if:
  1375. *        a. Passed pointer is equal to 65535
  1376. *        b. Character following character pointed to by pointer is CHR(0)
  1377. *
  1378. */
  1379. STATIC FUNCTION GetColumn( cFieldsBuffer, nOffset )
  1380.    LOCAL nPointer := 0, nNumber := 0, aColumn[ RC_COUNT ], cType
  1381.  
  1382.    // Column width
  1383.    aColumn[ RC_WIDTH ] := BIN2W(SUBSTR(cFieldsBuffer, nOffset + ;
  1384.         FIELD_WIDTH_OFFSET, 2))
  1385.  
  1386.    // Total column?
  1387.    aColumn[ RC_TOTAL ] := IF(SUBSTR(cFieldsBuffer, nOffset + ;
  1388.     FIELD_TOTALS_OFFSET, 1) $ "YyTt", .T., .F.)
  1389.  
  1390.    // Decimals width
  1391.    aColumn[ RC_DECIMALS ] := BIN2W(SUBSTR(cFieldsBuffer, nOffset + ;
  1392.         FIELD_DECIMALS_OFFSET, 2))
  1393.  
  1394.    // Offset (relative to FIELDS_OFFSET), 'point' to
  1395.    // expression area via array OFFSETS[]
  1396.  
  1397.    // Content expression
  1398.    nPointer = BIN2W(SUBSTR(cFieldsBuffer, nOffset +;
  1399.                FIELD_CONTENT_EXPR_OFFSET, 2))
  1400.    aColumn[ RC_TEXT ] := GetExpr( nPointer )
  1401.    aColumn[ RC_EXP ] := &( "{ || " + GetExpr( nPointer ) + "}" )
  1402.  
  1403.    // Header expression
  1404.    nPointer = BIN2W(SUBSTR(cFieldsBuffer, nOffset +;
  1405.                FIELD_HEADER_EXPR_OFFSET, 2))
  1406.  
  1407.    aColumn[ RC_HEADER ] := ListAsArray(GetExpr( nPointer ), ";")
  1408.  
  1409.    // Column picture
  1410.    // Setup picture only if a database file is open
  1411.    IF USED()
  1412.       cType := VALTYPE( EVAL(aColumn[ RC_EXP ]) )
  1413.       aColumn[ RC_TYPE ] := cType
  1414.       DO CASE
  1415.       CASE cType = "C" .OR. cType = "M"
  1416.          aColumn[ RC_PICT ] := REPLICATE("X", aColumn[ RC_WIDTH ])
  1417.       CASE cType = "D"
  1418.          aColumn[ RC_PICT ] := "@D"
  1419.       CASE cType = "N"
  1420.          IF aColumn[ RC_DECIMALS ] != 0
  1421.             aColumn[ RC_PICT ] := REPLICATE("9", aColumn[ RC_WIDTH ] - aColumn[ RC_DECIMALS ] -1) + "." + ;
  1422.                                   REPLICATE("9", aColumn[ RC_DECIMALS ])
  1423.          ELSE
  1424.             aColumn[ RC_PICT ] := REPLICATE("9", aColumn[ RC_WIDTH ])
  1425.          ENDIF
  1426.       CASE cType = "L"
  1427.          aColumn[ RC_PICT ] := "@L" + REPLICATE("X",aColumn[ RC_WIDTH ]-1)
  1428.       ENDCASE
  1429.    ENDIF
  1430.  
  1431.    // Update offset into ?_buffer
  1432.    nOffset += 12
  1433.  
  1434.    RETURN ( aColumn )
  1435.  
  1436. /***
  1437. *
  1438. *  ListAsArray( <cList>, <cDelimiter> ) --> aList
  1439. *  Convert a delimited string to an array
  1440. *
  1441. */
  1442. STATIC FUNCTION ListAsArray( cList, cDelimiter )
  1443.  
  1444.    LOCAL nPos
  1445.    LOCAL aList := {}                  // Define an empty array
  1446.    LOCAL lDelimLast := .F.
  1447.  
  1448.    IF cDelimiter == NIL
  1449.       cDelimiter := ","
  1450.    ENDIF
  1451.  
  1452.    DO WHILE ( LEN(cList) <> 0 )
  1453.  
  1454.       nPos := AT(cDelimiter, cList)
  1455.  
  1456.       IF ( nPos == 0 )
  1457.          nPos := LEN(cList)
  1458.       ENDIF
  1459.  
  1460.       IF ( SUBSTR( cList, nPos, 1 ) == cDelimiter )
  1461.          lDelimLast := .T.
  1462.          AADD(aList, SUBSTR(cList, 1, nPos - 1)) // Add a new element
  1463.       ELSE
  1464.          lDelimLast := .F.
  1465.          AADD(aList, SUBSTR(cList, 1, nPos)) // Add a new element
  1466.       ENDIF
  1467.  
  1468.       cList := SUBSTR(cList, nPos + 1)
  1469.  
  1470.    ENDDO
  1471.  
  1472.    IF ( lDelimLast )
  1473.       AADD(aList, "")
  1474.    ENDIF
  1475.  
  1476.    RETURN aList                       // Return the array
  1477.  
  1478. /***
  1479. *
  1480. *  Lblrun.prg
  1481. *
  1482. *  Clipper LABEL FORM runtime system
  1483. *
  1484. *  Copyright (c) 1990-1993, Computer Associates International, Inc.
  1485. *  All rights reserved.
  1486. *
  1487. *  Compile: /m /n /w
  1488. *
  1489. */
  1490.  
  1491.  
  1492. /***
  1493. *  Nation Message Constants
  1494. *  These constants are used with the NationMsg(<msg>) function.
  1495. *  The <msg> parameter can range from 1-12 and returns the national
  1496. *  version of the system message.
  1497. */
  1498. #define _LF_SAMPLES      2      // "Do you want more samples?"
  1499. #define _LF_YN           12     // "Y/N"
  1500.  
  1501.  
  1502. /***
  1503. *
  1504. *  __LabelForm( <cLBLName>, [<lPrinter>], <cAltFile>, [<lNoConsole>],
  1505. *        <bFor>, <bWhile>, <nNext>, <nRecord>, <lRest>, [<lSample>] )
  1506. *
  1507. *  Print the specified (.lbl) definition for specified records
  1508. *  meeting specified scope and condition
  1509. *
  1510. */
  1511. PROCEDURE __LabelForm( cLBLName, lPrinter, cAltFile, lNoConsole, bFor, ;
  1512.                        bWhile, nNext, nRecord, lRest, lSample )
  1513.    LOCAL lPrintOn := .F.               // PRINTER status
  1514.    LOCAL lConsoleOn                    // CONSOLE status
  1515.    LOCAL cExtraFile, lExtraState       // EXTRA file status
  1516.    LOCAL xBreakVal, lBroke := .F.
  1517.    LOCAL err
  1518.    Local OldMargin
  1519.  
  1520.  
  1521.    // Resolve parameters
  1522.    IF cLBLName == NIL
  1523.       err := ErrorNew()
  1524.       err:severity := ES_ERROR
  1525.       err:genCode := EG_ARG
  1526.       err:subSystem := "FRMLBL"
  1527.       Eval(ErrorBlock(), err)
  1528.  
  1529.    ELSE
  1530.       IF AT( ".", cLBLName ) == 0
  1531.          cLBLName := TRIM( cLBLName ) + ".LBL"
  1532.       ENDIF
  1533.  
  1534.    ENDIF
  1535.  
  1536.    IF lPrinter == NIL
  1537.       lPrinter := .F.
  1538.    ENDIF
  1539.  
  1540.    IF lSample == NIL
  1541.       lSample := .F.
  1542.    ENDIF
  1543.  
  1544.    // Set output devices
  1545.    IF lPrinter             // To the printer
  1546.       lPrintOn  := SET( _SET_PRINTER, lPrinter )
  1547.    ENDIF
  1548.  
  1549.    lConsoleOn := SET( _SET_CONSOLE )
  1550.    SET( _SET_CONSOLE, ! ( lNoConsole .OR. !lConsoleOn ) )
  1551.  
  1552.    IF (!Empty(cAltFile))         // To file
  1553.       lExtraState := SET( _SET_EXTRA, .T. )
  1554.       cExtraFile  := SET( _SET_EXTRAFILE, cAltFile )
  1555.    ENDIF
  1556.  
  1557.    OldMargin := SET( _SET_MARGIN, 0)
  1558.    
  1559.    BEGIN SEQUENCE
  1560.  
  1561.       aLabelData := __LblLoad( cLBLName )  // Load the (.lbl) into an array
  1562.  
  1563.       // Add to the left margin if a SET MARGIN has been defined
  1564.       aLabelData[ LB_LMARGIN ] += OldMargin
  1565.  
  1566.       // Size the aBandToPrint array to the number of fields
  1567.       ASIZE( aBandToPrint, LEN( aLabelData[ LB_FIELDS ] ) )
  1568.       AFILL( aBandToPrint, SPACE( aLabelData[ LB_LMARGIN ] ) )
  1569.  
  1570.       // Create enough space for a blank record
  1571.       cBlank := SPACE( aLabelData[ LB_WIDTH ] + aLabelData[ LB_SPACES ] )
  1572.  
  1573.       // Handle sample labels
  1574.       IF lSample
  1575.          SampleLabels()
  1576.       ENDIF
  1577.  
  1578.       // Execute the actual label run based on matching records
  1579.       DBEval( { || ExecuteLabel() }, bFor, bWhile, nNext, nRecord, lRest )
  1580.  
  1581.       // Print the last band if there is one
  1582.       IF lOneMoreBand
  1583.          // Print the band
  1584.          AEVAL( aBandToPrint, { | BandLine | PrintIt( BandLine ) } )
  1585.  
  1586.       ENDIF
  1587.  
  1588.  
  1589.    RECOVER USING xBreakVal
  1590.  
  1591.       lBroke := .T.
  1592.  
  1593.    END SEQUENCE
  1594.  
  1595.    // Clean up and leave
  1596.    aLabelData   := {}                // Recover the space
  1597.    aBandToPrint := {}
  1598.    nCurrentCol  := 1
  1599.    cBlank       := ""
  1600.    lOneMoreBand :=.T.
  1601.  
  1602.    // clean up
  1603.    SET( _SET_PRINTER, lPrintOn ) // Set the printer back to prior state
  1604.    SET( _SET_CONSOLE, lConsoleOn )  // Set the console back to prior state
  1605.  
  1606.    IF (!Empty(cAltFile))            // Set extrafile back
  1607.       SET( _SET_EXTRAFILE, cExtraFile )
  1608.       SET( _SET_EXTRA, lExtraState )
  1609.    ENDIF
  1610.  
  1611.    IF lBroke
  1612.       BREAK xBreakVal               // continue breaking
  1613.    ENDIF
  1614.  
  1615.    SET( _SET_MARGIN, OldMargin)
  1616.    
  1617.    RETURN
  1618.  
  1619. /***
  1620. *
  1621. *  ExecuteLabel()
  1622. *  Process the label array using the current record
  1623. *
  1624. */
  1625. STATIC PROCEDURE ExecuteLabel
  1626.    LOCAL nField, nMoreLines, aBuffer := {}, cBuffer
  1627.    LOCAL v
  1628.  
  1629.    // Load the current record into aBuffer
  1630.    FOR nField := 1 TO LEN( aLabelData[ LB_FIELDS ] )
  1631.  
  1632.       if ( aLabelData[ LB_FIELDS, nField ] <> NIL )
  1633.  
  1634.          v := Eval( aLabelData[ LB_FIELDS, nField, LF_EXP ] )
  1635.  
  1636.          cBuffer := PadR( v, aLabelData[ LB_WIDTH ] )
  1637.          cBuffer += Space( aLabelData[ LB_SPACES ] )
  1638.  
  1639.          if ( aLabelData[ LB_FIELDS, nField, LF_BLANK ] )
  1640.             if ( !Empty( cBuffer ) )
  1641.                AADD( aBuffer, cBuffer )
  1642.             end
  1643.          else
  1644.             AADD( aBuffer, cBuffer )
  1645.          endif
  1646.  
  1647.       else
  1648.  
  1649.          AADD( aBuffer, NIL )
  1650.  
  1651.       end
  1652.  
  1653.    NEXT
  1654.  
  1655.    ASIZE( aBuffer, LEN( aLabelData[ LB_FIELDS ] ) )
  1656.  
  1657.    // Add aBuffer to aBandToPrint
  1658.    FOR nField := 1 TO LEN( aLabelData[ LB_FIELDS ] )
  1659.       IF aBuffer[ nField ] == NIL
  1660.          aBandToPrint[ nField ] += cBlank
  1661.       ELSE
  1662.          aBandToPrint[ nField ] += aBuffer[ nField ]
  1663.       ENDIF
  1664.    NEXT
  1665.  
  1666.    IF nCurrentCol == aLabelData[ LB_ACROSS ]
  1667.  
  1668.      // trim
  1669.      FOR nField := 1 TO LEN( aBandToPrint )
  1670.        aBandToPrint[ nField ] := Trim( aBandToPrint[ nField ] )
  1671.      NEXT
  1672.  
  1673.  
  1674.       lOneMoreBand := .F.
  1675.       nCurrentCol  := 1
  1676.  
  1677.       // Print the band
  1678.       AEVAL( aBandToPrint, { | BandLine | PrintIt( BandLine ) } )
  1679.  
  1680.       nMoreLines := aLabelData[ LB_HEIGHT ] - LEN( aBandToPrint )
  1681.       IF nMoreLines > 0
  1682.          FOR nField := 1 TO nMoreLines
  1683.             PrintIt()
  1684.          NEXT
  1685.       ENDIF
  1686.       IF aLabelData[ LB_LINES ] > 0
  1687.  
  1688.          // Add the spaces between the label lines
  1689.          FOR nField := 1 TO aLabelData[ LB_LINES ]
  1690.             PrintIt()
  1691.          NEXT
  1692.  
  1693.       ENDIF
  1694.  
  1695.       // Clear out the band
  1696.       AFILL( aBandToPrint, SPACE( aLabelData[ LB_LMARGIN ] ) )
  1697.    ELSE
  1698.       lOneMoreBand := .T.
  1699.       nCurrentCol++
  1700.    ENDIF
  1701.  
  1702.    RETURN
  1703.  
  1704. /***
  1705. *
  1706. *  SampleLabels()
  1707. *  Print sample labels
  1708. *
  1709. */
  1710. STATIC PROCEDURE SampleLabels
  1711.    LOCAL nGetKey, lMoreSamples := .T., nField
  1712.    LOCAL aBand := {}
  1713.  
  1714.    // Create the sample label row
  1715.    ASIZE( aBand, aLabelData[ LB_HEIGHT ] )
  1716.    AFILL( aBand, SPACE( aLabelData[ LB_LMARGIN ] ) +;
  1717.               REPLICATE( REPLICATE( "*", ;
  1718.               aLabelData[ LB_WIDTH ] ) + ;
  1719.               SPACE( aLabelData[ LB_SPACES ] ), ;
  1720.               aLabelData[ LB_ACROSS ] ) )
  1721.  
  1722.    // Prints sample labels
  1723.    DO WHILE lMoreSamples
  1724.  
  1725.       // Print the samples
  1726.       AEVAL( aBand, { | BandLine | PrintIt( BandLine ) } )
  1727.  
  1728.       IF aLabelData[ LB_LINES ] > 0
  1729.          // Add the spaces between the label lines
  1730.          FOR nField := 1 TO aLabelData[ LB_LINES ]
  1731.             PrintIt()
  1732.          NEXT nField
  1733.       ENDIF
  1734.  
  1735.       // Prompt for more
  1736.       @ ROW(), 0 SAY NationMsg(_LF_SAMPLES)+" ("+Nationmsg(_LF_YN)+")"
  1737.       nGetKey := INKEY(0)
  1738.       @ ROW(), COL() SAY CHR(nGetKey)
  1739.       IF ROW() == MAXROW()
  1740.          SCROLL( 0, 0, MAXROW(), MAXCOL(), 1 )
  1741.          @ MAXROW(), 0 SAY ""
  1742.       ELSE
  1743.          @ ROW()+1, 0 SAY ""
  1744.       ENDIF
  1745.       IF IsNegative(CHR(nGetKey))   // Don't give sample labels
  1746.          lMoreSamples := .F.
  1747.       ENDIF
  1748.    ENDDO
  1749.    RETURN
  1750.  
  1751. /***
  1752. *
  1753. *  PrintIt( <cString> )
  1754. *  Print a string, then send a CRLF
  1755. *
  1756. */
  1757. *STATIC PROCEDURE PrintIt( cString )
  1758.  
  1759. *   IF cString == NIL
  1760. *      cString := ""
  1761. *   ENDIF
  1762. *   QQOUT( cString )
  1763. *   QOUT()
  1764.  
  1765. *   RETURN
  1766.  
  1767.  
  1768. FUNCTION __LblLoad( cLblFile )
  1769.    LOCAL i, j       := 0                  // Counters
  1770.    LOCAL cBuff      := SPACE(BUFFSIZE)    // File buffer
  1771.    LOCAL nHandle    := 0                  // File handle
  1772.    LOCAL nReadCount := 0                  // Bytes read from file
  1773.    LOCAL lStatus    := .F.                // Status
  1774.    LOCAL nOffset    := FILEOFFSET         // Offset into file
  1775.    LOCAL nFileError := F_OK               // File error
  1776.    LOCAL cFieldText := ""                 // Text expression container
  1777.    LOCAL err                              // error object
  1778.  
  1779.    LOCAL cDefPath          // contents of SET DEFAULT string
  1780.    LOCAL aPaths            // array of paths
  1781.    LOCAL nPathIndex := 0   // iteration counter
  1782.  
  1783.    // Create and initialize default label array
  1784.    LOCAL aLabel[ LB_COUNT ]
  1785.    aLabel[ LB_REMARK ]  := SPACE(60)      // Label remark
  1786.    aLabel[ LB_HEIGHT ]  := 5              // Label height
  1787.    aLabel[ LB_WIDTH ]   := 35             // Label width
  1788.    aLabel[ LB_LMARGIN ] := 0              // Left margin
  1789.    aLabel[ LB_LINES ]   := 1              // Lines between labels
  1790.    aLabel[ LB_SPACES ]  := 0              // Spaces between labels
  1791.    aLabel[ LB_ACROSS ]  := 1              // Number of labels across
  1792.    aLabel[ LB_FIELDS ]  := {}             // Array of label fields
  1793.  
  1794.    // Open the label file
  1795.    nHandle := FOPEN( cLblFile )
  1796.  
  1797.    IF ( ! EMPTY( nFileError := FERROR() ) ) .AND. !( "\" $ cLblFile .OR. ":" $ cLblFile )
  1798.  
  1799.       // Search through default path; attempt to open label file
  1800.       cDefPath := SET( _SET_DEFAULT )
  1801.       cDefPath := STRTRAN( cDefPath, ",", ";" )
  1802.       aPaths := ListAsArray( cDefPath, ";" )
  1803.  
  1804.       FOR nPathIndex := 1 TO LEN( aPaths )
  1805.          nHandle := FOPEN( aPaths[ nPathIndex ] + "\" + cLblFile )
  1806.          // if no error is reported, we have our label file
  1807.          IF EMPTY( nFileError := FERROR() )
  1808.             EXIT
  1809.  
  1810.          ENDIF
  1811.  
  1812.       NEXT nPathIndex
  1813.  
  1814.    ENDIF
  1815.  
  1816.    // File error
  1817.    IF nFileError != F_OK
  1818.       err := ErrorNew()
  1819.       err:severity := ES_ERROR
  1820.       err:genCode := EG_OPEN
  1821.       err:subSystem := "FRMLBL"
  1822.       err:osCode := nFileError
  1823.       err:filename := cLblFile
  1824.       Eval(ErrorBlock(), err)
  1825.    ENDIF
  1826.  
  1827.    // If we got this far, assume the label file is open and ready to go
  1828.    // and so go ahead and read it
  1829.    nReadCount := FREAD( nHandle, @cBuff, BUFFSIZE )
  1830.  
  1831.    // READ ok?
  1832.    IF nReadCount == 0
  1833.       nFileError := F_EMPTY             // File is empty
  1834.    ELSE
  1835.       nFileError := FERROR()            // Check for DOS errors
  1836.    ENDIF
  1837.  
  1838.    IF nFileError == 0
  1839.  
  1840.       // Load label dimension into aLabel
  1841.       aLabel[ LB_REMARK ] := SUBSTR(cBuff, REMARKOFFSET, REMARKSIZE)
  1842.       aLabel[ LB_HEIGHT ] := BIN2W(SUBSTR(cBuff, HEIGHTOFFSET, HEIGHTSIZE))
  1843.       aLabel[ LB_WIDTH  ] := BIN2W(SUBSTR(cBuff, WIDTHOFFSET, WIDTHSIZE))
  1844.       aLabel[ LB_LMARGIN] := BIN2W(SUBSTR(cBuff, LMARGINOFFSET, LMARGINSIZE))
  1845.       aLabel[ LB_LINES  ] := BIN2W(SUBSTR(cBuff, LINESOFFSET, LINESSIZE))
  1846.       aLabel[ LB_SPACES ] := BIN2W(SUBSTR(cBuff, SPACESOFFSET, SPACESSIZE))
  1847.       aLabel[ LB_ACROSS ] := BIN2W(SUBSTR(cBuff, ACROSSOFFSET, ACROSSSIZE))
  1848.  
  1849.       FOR i := 1 TO aLabel[ LB_HEIGHT ]
  1850.  
  1851.          // Get the text of the expression
  1852.          cFieldText := TRIM( SUBSTR( cBuff, nOffset, FIELDSIZE ) )
  1853.          nOffset += 60
  1854.  
  1855.          IF !EMPTY( cFieldText )
  1856.  
  1857.             AADD( aLabel[ LB_FIELDS ], {} )
  1858.  
  1859.             // Field expression
  1860.             AADD( aLabel[ LB_FIELDS, i ], &( "{ || " + cFieldText + "}" ) )
  1861.  
  1862.             // Text of field
  1863.             AADD( aLabel[ LB_FIELDS, i ], cFieldText )
  1864.  
  1865.             // Compression option
  1866.             AADD( aLabel[ LB_FIELDS, i ], .T. )
  1867.  
  1868.        ELSE
  1869.  
  1870.          AADD( aLabel[ LB_FIELDS ], NIL )
  1871.  
  1872.          ENDIF
  1873.  
  1874.       NEXT
  1875.  
  1876.       // Close file
  1877.       FCLOSE( nHandle )
  1878.       nFileError = FERROR()
  1879.  
  1880.    ENDIF
  1881.    RETURN( aLabel )
  1882.  
  1883. FUNCTION IsNegative(AVal)
  1884. RETURN AVal < 0
  1885.