Clipper Support Bulletin #6
LABEL FORM problems and workarounds

Copyright (c) 1991, 1992 Nantucket Corporation.  All rights reserved.


Version:  Clipper 5.0, revisions 1.00 - 1.03
Date:     8th January, 1991
Revised:  22nd May, 1992
Status:   Inactive

================================================================================

This Support Bulletin covers the following topics:

   1. Type mismatch error
   2. Performing a SET MARGIN before a LABEL FORM
   3. Erroneous NOCONSOLE handling
   4. Revised Lblrun.prg code

================================================================================
1. Type mismatch error
   
   PROBLEM: The LABEL FORM command is used, and works correctly.
   However, if used a second time, a "Type Mismatch" error occurs.
   
   REASON:  STATIC variables which were defined and assigned during
   the label routine's initial invocation were later assigned NIL
   values.  This resulted in an error on subsequent invocations,
   because the code was not designed to handle any of the variables
   having a NIL value.
   
   FIX:  Instead of assigning NIL values, the variables are now reset
   to their original values (where appropriate).
   
================================================================================
2. Performing a SET MARGIN before a LABEL FORM
   
   PROBLEM: Issuing a SET MARGIN prior to a LABEL FORM caused labels
   to be printed at a column position equal to three times the margin
   setting.
   
   REASON:  First, the code for the label routine was adding the
   margin twice.  Eliminating the second addition in two separate
   places in the code fixed this problem.
   
   Second, all label lines other than the first one are output using
   QOUT() (the functional equivalent of the ? command).  This
   function moves the print head down after each line and respects
   any SET MARGIN value. This accounts for the third multiple of the
   margin.
   
   FIX:  The problem was solved by temporarily eliminating the margin
   during execution of the label routine and reassigning it upon
   completion.  The current margin setting was retrieved using the
   SET() function and stored in a local variable.  Upon completion of
   the routine, the margin was reset to the value contained in this
   local variable.
   
   At this point anyone reading this might begin to wonder why all
   this trouble was taken.  It may seem easier to just eliminate all
   the internal margin handling and let the global effect upon QOUT()
   deal with the problem.  However, some may recall a Summer '87
   problem where the first line of a label would not respect the
   margin.  This occurred because the first line of a label is output
   with QQOUT() (the functional equivalent of the ?? command), which
   is not affected by SET MARGIN.
   
   This means that this version of the label routine is not Summer
   '87 compatible, as it will be respecting the margin on all printed
   lines.  Some developers may have placed a workaround in their code
   for the Summer '87 behavior.  This is probably in the form of a
   routine which will use printer escape sequences to place the print
   head at the desired margin offset before running the label form.
   Developers with such routines will need to remove that code.
   Failure to remove the Summer '87  workaround code will cause the
   first line to be printed at a column which is twice the margin.
   
================================================================================
3. Erroneous NOCONSOLE handling
   
   PROBLEM: Lines 134-136 of LBLRUN.prg are as follows:
   
   IF lConsole                             // To the screen
     lConsoleOn := SET( _SET_CONSOLE, lConsole )
   ENDIF
   
   lConsole is the NOCONSOLE parameter passed to LBLRUN. The
   preprocessor uses a logify result-marker for this parameter, which
   means that lConsole has a value of True (.T.) if NOCONSOLE was
   specified.  This causes the code listed above to turn the console
   on if NOCONSOLE was specified.
   
   FIX: Change the above lines of code to the following:
   
   IF lConsole                             // To the screen
     lConsoleOn := SET( _SET_CONSOLE, !lConsole )
   ENDIF
   
================================================================================
4. Revised Lblrun.prg code
   
/***
   *
   *   Lblrun.prg
   *   Clipper 5.0 LABEL FORM runtime system
   *   Copyright (c) 1990 Nantucket Corp.  All rights reserved
   *
   
*   Compile:  /m/n/w
*/

#include "lbldef.ch"          // Label array definitions
#include "error.ch"

// Filewide static declarations
STATIC aLabelData   := {}     // Label definition array
STATIC aBandToPrint := {}
STATIC cBlank    := ""
STATIC lOneMoreBand := .T.
STATIC nCurrentCol  := 1      // The current column in the band




/***
*  __LabelForm( ... ) --> NIL
*  Print the specified (.lbl) definition for specified records
*  meeting specified scope and condition
*/
FUNCTION __LabelForm( cLBLName, lPrinter, cAltFile, lConsole, bFor, ;
   bWhile, nNext, nRecord, lRest, lSample )

   LOCAL lPrintOn := .F.            // PRINTER status
   LOCAL lConsoleOn := .T.          // CONSOLE status
   LOCAL cExtraFile, lExtraState    // EXTRA status
   LOCAL xBreakVal, lBroke := .F.
   LOCAL err
   Local OldMargin


   // Resolve parameters
   IF cLBLName == NIL
      err := ErrorNew()
      err:severity := 2
      err:genCode := EG_ARG
      err:subSystem := "FRMLBL"
      Eval(ErrorBlock(), err)
   ELSE
      IF AT( ".", cLBLName ) == 0
         cLBLName := TRIM( cLBLName ) + ".LBL"
      ENDIF
   ENDIF

   IF lPrinter == NIL
      lPrinter := .F.
   ENDIF

   IF lConsole == NIL
      lConsole := .T.
   ENDIF

   IF lSample == NIL

      lSample := .F.
   ENDIF

   // Set output devices
   IF lPrinter           // To the printer
      lPrintOn  := SET( _SET_PRINTER, lPrinter )
   ENDIF
   IF lConsole           // To the screen
      lConsoleOn := SET( _SET_CONSOLE, !lConsole )
   ENDIF

   IF (!Empty(cAltFile))      // To file
      cExtraFile  := SET( _SET_EXTRAFILE, cAltFile )
      lExtraState := SET( _SET_EXTRA, .T. )
   ENDIF

   OldMargin := SET( _SET_MARGIN, 0)

   BEGIN SEQUENCE

      aLabelData := __LblLoad( cLBLName )  // Load the (.lbl) into an array

      // Add to the left margin if a SET MARGIN has been defined
      aLabelData[ LB_LMARGIN ] += OldMargin

      // Size the aBandToPrint array to the number of fields
      ASIZE( aBandToPrint, LEN( aLabelData[ LB_FIELDS ] ) )
      AFILL( aBandToPrint, SPACE( aLabelData[ LB_LMARGIN ] ) )

      // Create enough space for a blank record
      cBlank := SPACE( aLabelData[ LB_WIDTH ] + aLabelData[ LB_SPACES ] )

      // Handle sample labels
      IF lSample
         SampleLabels()
      ENDIF

      // Execute the actual label run based on matching records
      DBEval( { || ExecuteLabel() }, bFor, bWhile, nNext, nRecord, lRest )

      // Print the last band if there is one
      IF lOneMoreBand
         // Print the band
         AEVAL( aBandToPrint, ;
            { | BandLine | ; // PrintIt(SPACE(aLabelData[LB_LMARGIN])+ BandLine);
            PrintIt( BandLine ) } )
      ENDIF


   RECOVER USING xBreakVal

      lBroke := .T.

   END // Sequence



   // Clean up and leave
   aLabelData   := {}       // Recover the space
   aBandToPrint := {}
   nCurrentCol  := 1
   cBlank       := ""
   lOneMoreBand :=.T.

   // Clean up
   SET( _SET_PRINTER, lPrintOn )    // Set the printer back to prior state
   SET( _SET_CONSOLE, lConsoleOn )// Set the console back to prior state

   IF (!Empty(cAltFile))    // Set extrafile back
      SET( _SET_EXTRAFILE, cExtraFile )
      SET( _SET_EXTRA, lExtraState )
   ENDIF

   IF lBroke
      // keep the break value going
      BREAK xBreakVal
   ENDIF

   SET( _SET_MARGIN, OldMargin)

   RETURN NIL




/***
*  ExecuteLabel() --> NIL
*  Process the label array using the current record
*/
STATIC FUNCTION ExecuteLabel
   LOCAL nField, nMoreLines, aBuffer := {}, cBuffer

   // Load the current record into aBuffer
   FOR nField := 1 TO LEN( aLabelData[ LB_FIELDS ] )
      cBuffer := PADR(TRANSFORM( EVAL( aLabelData[ LB_FIELDS,nField,;
         LF_EXP ] ), ;
         REPLICATE( "X", aLabelData[ LB_WIDTH ] ) ), ;
         aLabelData[ LB_WIDTH ] + aLabelData[ LB_SPACES ])
      IF aLabelData[ LB_FIELDS, nField, LF_BLANK ]
         IF RTRIM( cBuffer ) == ""     // If it's a blank field
         ELSE
            AADD( aBuffer, cBuffer )
         ENDIF
      ELSE
         AADD( aBuffer, cBuffer )
      ENDIF
   NEXT
   ASIZE( aBuffer, LEN( aLabelData[ LB_FIELDS ] ) )


   // Add aBuffer to aBandToPrint
   FOR nField := 1 TO LEN( aLabelData[ LB_FIELDS ] )
      IF aBuffer[ nField ] == NIL
         aBandToPrint[ nField ] += cBlank
      ELSE
         aBandToPrint[ nField ] += aBuffer[ nField ]
      ENDIF
   NEXT

   IF nCurrentCol == aLabelData[ LB_ACROSS ]
      lOneMoreBand := .F.
      nCurrentCol  := 1

      // Print the band
      AEVAL( aBandToPrint, ;
         { | BandLine | ; //PrintIt(SPACE(aLabelData[LB_LMARGIN])+ BandLine);
         PrintIt( BandLine ) } )
      nMoreLines := aLabelData[ LB_HEIGHT ] - LEN( aBandToPrint )
      IF nMoreLines > 0
         FOR nField := 1 TO nMoreLines
            PrintIt()
         NEXT
      ENDIF
      IF aLabelData[ LB_LINES ] > 0

         // Add the spaces between the label lines
         FOR nField := 1 TO aLabelData[ LB_LINES ]
            PrintIt()
         NEXT

      ENDIF

      // Clear out the band
      AFILL( aBandToPrint, SPACE( aLabelData[ LB_LMARGIN ] ) )
   ELSE
      lOneMoreBand := .T.
      nCurrentCol++
   ENDIF

   RETURN NIL




/***
*  SampleLabels() --> NIL
*  Print sample labels
*/
STATIC FUNCTION SampleLabels
   LOCAL nGetKey, lMoreSamples := .T., nField
   LOCAL aBand := {}

   // Create the sample label row
   ASIZE( aBand, aLabelData[ LB_HEIGHT ] )

   AFILL( aBand, SPACE( aLabelData[ LB_LMARGIN ] ) +;
      REPLICATE( REPLICATE( "*", ;
      aLabelData[ LB_WIDTH ] ) + ;
      SPACE( aLabelData[ LB_SPACES ] ), ;
      aLabelData[ LB_ACROSS ] ) )

   // Prints sample labels
   DO WHILE lMoreSamples

      // Print the samples
      AEVAL( aBand, ;
         { | BandLine | PrintIt( BandLine ) } )
      IF aLabelData[ LB_LINES ] > 0
         // Add the spaces between the label lines
         FOR nField := 1 TO aLabelData[ LB_LINES ]
            PrintIt()
         NEXT
      ENDIF

      // Prompt for more
      @ ROW(), 0 SAY "Do you want more samples? (Y/N)"
      nGetKey := INKEY(0)
      @ ROW(), COL() SAY CHR(nGetKey)
      IF ROW() == MAXROW()
         SCROLL( 0, 0, MAXROW(), MAXCOL(), 1 )
         @ MAXROW(), 0 SAY ""
      ELSE
         @ ROW()+1, 0 SAY ""
      ENDIF
      IF UPPER(CHR(nGetKey)) == "N"
         lMoreSamples := .F.
      ENDIF
   ENDDO
   RETURN NIL




/***
*  PrintIt( <cString> ) --> NIL
*  Print a string, then send a CRLF
*/
STATIC FUNCTION PrintIt( cString )
   IF cString == NIL
      cString := ""
   ENDIF
   QQOUT( cString )
   QOUT()
   RETURN NIL

                                        
                                      * * *