/* * $Id$ */ /* * Harbour Project source code: * HBLabelForm class and __LabelForm() * * Copyright 2000 Luiz Rafael Culik * www - http://www.harbour-project.org * * This program is free software; you can redistribute it and/or modify * it under the terms of the GNU General Public License as published by * the Free Software Foundation; either version 2, or (at your option) * any later version. * * This program is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * GNU General Public License for more details. * * You should have received a copy of the GNU General Public License * along with this software; see the file COPYING. If not, write to * the Free Software Foundation, Inc., 59 Temple Place, Suite 330, * Boston, MA 02111-1307 USA (or visit the web site http://www.gnu.org/). * * As a special exception, the Harbour Project gives permission for * additional uses of the text contained in its release of Harbour. * * The exception is that, if you link the Harbour libraries with other * files to produce an executable, this does not by itself cause the * resulting executable to be covered by the GNU General Public License. * Your use of that executable is in no way restricted on account of * linking the Harbour library code into it. * * This exception does not however invalidate any other reasons why * the executable file might be covered by the GNU General Public License. * * This exception applies only to the code released by the Harbour * Project under the name Harbour. If you copy code from other * Harbour Project or Free Software Foundation releases into a copy of * Harbour, as the General Public License permits, the exception does * not apply to the code that you add in this way. To avoid misleading * anyone as to the status of such modified files, you must delete * this exception notice from them. * * If you write modifications of your own for Harbour, it is your choice * whether to permit this exception to apply to your modifications. * If you do not wish that, delete this exception notice. * */ #include "hbclass.ch" #include "error.ch" #include "fileio.ch" #include "inkey.ch" #define F_OK 0 // No error #define F_EMPTY -3 // File is empty #define _LF_SAMPLES 2 // "Do you want more samples?" #define _LF_YN 12 // "Y/N" #define LBL_REMARK 1 // Character, remark from label file #define LBL_HEIGHT 2 // Numeric, label height #define LBL_WIDTH 3 // Numeric, label width #define LBL_LMARGIN 4 // Numeric, left margin #define LBL_LINES 5 // Numeric, lines between labels #define LBL_SPACES 6 // Numeric, spaces between labels #define LBL_ACROSS 7 // Numeric, number of labels across #define LBL_FIELDS 8 // Array of Field arrays #define LBL_COUNT 8 // Numeric, number of label fields // Field array definitions ( one array per field ) #define LF_EXP 1 // Block, field expression #define LF_TEXT 2 // Character, text of field expression #define LF_BLANK 3 // Logical, compress blank fields, .T.=Yes .F.=No #define LF_COUNT 3 // Numeric, number of elements in field array #define BUFFSIZE 1034 // Size of label file #define FILEOFFSET 74 // Start of label content descriptions #define FIELDSIZE 60 #define REMARKOFFSET 2 #define REMARKSIZE 60 #define HEIGHTOFFSET 62 #define HEIGHTSIZE 2 #define WIDTHOFFSET 64 #define WIDTHSIZE 2 #define LMARGINOFFSET 66 #define LMARGINSIZE 2 #define LINESOFFSET 68 #define LINESSIZE 2 #define SPACESOFFSET 70 #define SPACESSIZE 2 #define ACROSSOFFSET 72 #define ACROSSSIZE 2 CLASS HBLabelForm DATA aLabelData AS ARRAY init {} DATA aBandToPrint AS ARRAY DATA cBlank AS STRING init "" DATA lOneMoreBand AS LOGICAL init .T. DATA nCurrentCol AS NUMERIC // The current column in the band METHOD New( cLBLName, lPrinter, cAltFile, lNoConsole, bFor, ; bWhile, nNext, nRecord, lRest, lSample ) METHOD ExecuteLabel() METHOD SampleLabels() METHOD LoadLabel(cLblFile) ENDCLASS METHOD New( cLBLName, lPrinter, cAltFile, lNoConsole, bFor, ; bWhile, nNext, nRecord, lRest, lSample ) CLASS HBLabelForm LOCAL lPrintOn := .F. // PRINTER status LOCAL lConsoleOn // CONSOLE status LOCAL cExtraFile, lExtraState // EXTRA file status LOCAL xBreakVal, lBroke := .F. LOCAL err LOCAL OldMargin LOCAL nLen ::aBandToPrint:={} // ARRAY(5) ::nCurrentCol := 1 // Resolve parameters IF cLBLName == NIL err := ErrorNew() err:severity := ES_ERROR 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 lSample == NIL lSample := .F. ENDIF // Set output devices IF lPrinter // To the printer lPrintOn := SET( _SET_PRINTER, lPrinter ) ENDIF lConsoleOn := SET( _SET_CONSOLE ) SET( _SET_CONSOLE, ! ( lNoConsole .OR. !lConsoleOn ) ) IF (!Empty(cAltFile)) // To file lExtraState := SET( _SET_EXTRA, .T. ) cExtraFile := SET( _SET_EXTRAFILE, cAltFile ) ENDIF OldMargin := SET( _SET_MARGIN, 0) BEGIN SEQUENCE ::aLabelData := ::LoadLabel( cLBLName ) // Load the (.lbl) into an array // Add to the left margin if a SET MARGIN has been defined ::aLabelData[ LBL_LMARGIN ] := ::aLabelData[ LBL_LMARGIN ] + OldMargin // Size the ::aBandToPrint array to the number of fields // nLen := LEN( ::aLabelData[ LBL_FIELDS ] ) ASIZE( ::aBandToPrint, LEN( ::aLabelData[ LBL_FIELDS ])) AFILL( ::aBandToPrint, SPACE( ::aLabelData[ LBL_LMARGIN ] ) ) // Create enough space for a blank record ::cBlank := SPACE( ::aLabelData[ LBL_WIDTH ] + ::aLabelData[ LBL_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( 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 BREAK xBreakVal // continue breaking ENDIF SET( _SET_MARGIN, OldMargin) RETURN Self METHOD ExecuteLabel() CLASS HBLabelForm LOCAL nField, nMoreLines, aBuffer := {}, cBuffer LOCAL v // Load the current record into aBuffer FOR nField := 1 TO LEN( ::aLabelData[ LBL_FIELDS ] ) if ( ::aLabelData[ LBL_FIELDS, nField ] <> NIL ) v := Eval( ::aLabelData[ LBL_FIELDS, nField, LF_EXP ] ) cBuffer := PadR( v, ::aLabelData[ LBL_WIDTH ] ) cBuffer := cBuffer + Space( ::aLabelData[ LBL_SPACES ] ) if ( ::aLabelData[ LBL_FIELDS, nField, LF_BLANK ] ) if ( !Empty( cBuffer ) ) AADD( aBuffer, cBuffer ) end else AADD( aBuffer, cBuffer ) endif else AADD( aBuffer, NIL ) end NEXT ASIZE( aBuffer, LEN( ::aLabelData[ LBL_FIELDS ] ) ) // Add aBuffer to ::aBandToPrint FOR nField := 1 TO LEN( ::aLabelData[ LBL_FIELDS ] ) IF aBuffer[ nField ] == NIL ::aBandToPrint[ nField ] := ::aBandToPrint[ nField ] + ::cBlank ELSE ::aBandToPrint[ nField ] := ::aBandToPrint[ nField ] + aBuffer[ nField ] ENDIF NEXT IF ::nCurrentCol == ::aLabelData[ LBL_ACROSS ] // trim FOR nField := 1 TO LEN( ::aBandToPrint ) ::aBandToPrint[ nField ] := Trim( ::aBandToPrint[ nField ] ) NEXT ::lOneMoreBand := .F. ::nCurrentCol := 1 // Print the band AEVAL( ::aBandToPrint, { | BandLine | PrintIt( BandLine ) } ) nMoreLines := ::aLabelData[ LBL_HEIGHT ] - LEN( ::aBandToPrint ) IF nMoreLines > 0 FOR nField := 1 TO nMoreLines PrintIt() NEXT ENDIF IF ::aLabelData[ LBL_LINES ] > 0 // Add the spaces between the label lines FOR nField := 1 TO ::aLabelData[ LBL_LINES ] PrintIt() NEXT ENDIF // Clear out the band AFILL( ::aBandToPrint, SPACE( ::aLabelData[ LBL_LMARGIN ] ) ) ELSE ::lOneMoreBand := .T. ::nCurrentCol := ::nCurrentCol + 1 ENDIF RETURN Self METHOD SampleLabels() CLASS HBLabelForm LOCAL nGetKey, lMoreSamples := .T., nField LOCAL aBand := {} // Create the sample label row ASIZE( aBand, ::aLabelData[ LBL_HEIGHT ] ) AFILL( aBand, SPACE( ::aLabelData[ LBL_LMARGIN ] ) +; REPLICATE( REPLICATE( "*", ; ::aLabelData[ LBL_WIDTH ] ) + ; SPACE( ::aLabelData[ LBL_SPACES ] ), ; ::aLabelData[ LBL_ACROSS ] ) ) // Prints sample labels DO WHILE lMoreSamples // Print the samples AEVAL( aBand, { | BandLine | PrintIt( BandLine ) } ) IF ::aLabelData[ LBL_LINES ] > 0 // Add the spaces between the label lines FOR nField := 1 TO ::aLabelData[ LBL_LINES ] PrintIt() NEXT nField ENDIF // Prompt for more @ ROW(), 0 SAY NationMsg(_LF_SAMPLES)+" ("+Nationmsg(_LF_YN)+")" 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 IsNegative(CHR(nGetKey)) // Don't give sample labels lMoreSamples := .F. ENDIF ENDDO RETURN Self METHOD LoadLabel( cLblFile ) CLASS HBLabelForm LOCAL i, j := 0 // Counters LOCAL cBuff := SPACE(BUFFSIZE) // File buffer LOCAL nHandle := 0 // File handle LOCAL nReadCount := 0 // Bytes read from file LOCAL lStatus := .F. // Status LOCAL nOffset := FILEOFFSET // Offset into file LOCAL nFileError := F_OK // File error LOCAL cFieldText := "" // Text expression container LOCAL err // error object LOCAL cDefPath // contents of SET DEFAULT string LOCAL aPaths // array of paths LOCAL nPathIndex := 0 // iteration counter // Create and initialize default label array LOCAL aLabel[ LBL_COUNT ] aLabel[ LBL_REMARK ] := SPACE(60) // Label remark aLabel[ LBL_HEIGHT ] := 5 // Label height aLabel[ LBL_WIDTH ] := 35 // Label width aLabel[ LBL_LMARGIN ] := 0 // Left margin aLabel[ LBL_LINES ] := 1 // Lines between labels aLabel[ LBL_SPACES ] := 0 // Spaces between labels aLabel[ LBL_ACROSS ] := 1 // Number of labels across aLabel[ LBL_FIELDS ] := {} // Array of label fields // Open the label file nHandle := FOPEN( cLblFile ) IF ( ! EMPTY( nFileError := FERROR() ) ) .AND. !( "\" $ cLblFile .OR. ":" $ cLblFile ) // Search through default path; attempt to open label file cDefPath := SET( _SET_DEFAULT ) cDefPath := STRTRAN( cDefPath, ",", ";" ) aPaths := ListAsArray( cDefPath, ";" ) FOR nPathIndex := 1 TO LEN( aPaths ) nHandle := FOPEN( aPaths[ nPathIndex ] + "\" + cLblFile ) // if no error is reported, we have our label file IF EMPTY( nFileError := FERROR() ) EXIT ENDIF NEXT nPathIndex ENDIF // File error IF nFileError != F_OK err := ErrorNew() err:severity := ES_ERROR err:genCode := EG_OPEN err:subSystem := "FRMLBL" err:osCode := nFileError err:filename := cLblFile Eval(ErrorBlock(), err) ENDIF // If we got this far, assume the label file is open and ready to go // and so go ahead and read it nReadCount := FREAD( nHandle, @cBuff, BUFFSIZE ) // READ ok? IF nReadCount == 0 nFileError := F_EMPTY // File is empty ELSE nFileError := FERROR() // Check for DOS errors ENDIF IF nFileError == 0 // Load label dimension into aLabel aLabel[ LBL_REMARK ] := SUBSTR(cBuff, REMARKOFFSET, REMARKSIZE) aLabel[ LBL_HEIGHT ] := BIN2W(SUBSTR(cBuff, HEIGHTOFFSET, HEIGHTSIZE)) aLabel[ LBL_WIDTH ] := BIN2W(SUBSTR(cBuff, WIDTHOFFSET, WIDTHSIZE)) aLabel[ LBL_LMARGIN] := BIN2W(SUBSTR(cBuff, LMARGINOFFSET, LMARGINSIZE)) aLabel[ LBL_LINES ] := BIN2W(SUBSTR(cBuff, LINESOFFSET, LINESSIZE)) aLabel[ LBL_SPACES ] := BIN2W(SUBSTR(cBuff, SPACESOFFSET, SPACESSIZE)) aLabel[ LBL_ACROSS ] := BIN2W(SUBSTR(cBuff, ACROSSOFFSET, ACROSSSIZE)) FOR i := 1 TO aLabel[ LBL_HEIGHT ] // Get the text of the expression cFieldText := TRIM( SUBSTR( cBuff, nOffset, FIELDSIZE ) ) nOffset :=nOffSet + 60 IF !EMPTY( cFieldText ) AADD( aLabel[ LBL_FIELDS ], {} ) // Field expression AADD( aLabel[ LBL_FIELDS, i ], &( "{ || " + cFieldText + "}" ) ) // Text of field AADD( aLabel[ LBL_FIELDS, i ], cFieldText ) // Compression option AADD( aLabel[ LBL_FIELDS, i ], .T. ) ELSE AADD( aLabel[ LBL_FIELDS ], NIL ) ENDIF NEXT // Close file FCLOSE( nHandle ) nFileError := FERROR() ENDIF RETURN aLabel FUNCTION __LabelForm( cLBLName, lPrinter, cAltFile, lNoConsole, bFor, ; bWhile, nNext, nRecord, lRest, lSample ) RETURN HBLabelForm():New( cLBLName, lPrinter, cAltFile, lNoConsole, bFor, ; bWhile, nNext, nRecord, lRest, lSample ) STATIC PROCEDURE PrintIt( cString ) IF cString == NIL cString := "" ENDIF QQOUT( cString ) QOUT() RETURN STATIC FUNCTION ListAsArray( cList, cDelimiter ) LOCAL nPos LOCAL aList := {} // Define an empty array LOCAL lDelimLast := .F. IF cDelimiter == NIL cDelimiter := "," ENDIF DO WHILE LEN(cList) <> 0 nPos := AT(cDelimiter, cList) IF nPos == 0 nPos := LEN(cList) ENDIF IF ( SUBSTR( cList, nPos, 1 ) == cDelimiter ) lDelimLast := .T. AADD(aList, SUBSTR(cList, 1, nPos - 1)) // Add a new element ELSE lDelimLast := .F. AADD(aList, SUBSTR(cList, 1, nPos)) // Add a new element ENDIF cList := SUBSTR(cList, nPos + 1) ENDDO IF lDelimLast AADD(aList, "") ENDIF RETURN aList // Return the array