fivedev/harbour-core
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

See changelog 20000213 15:50

Browse Source
This commit is contained in:
Luiz Rafael Culik
2000-02-13 17:55:07 +00:00
parent fb03be6899
commit ceb4cd9a19
10 changed files with 1966 additions and 3 deletions
Download Patch File Download Diff File Expand all files Collapse all files

18
harbour/ChangeLog
View File

@@ -1,3 +1,21 @@
20000213-15:50 GMT-3 Luiz Rafael Culik <culik@sl.conex.net>
*makefile.bc
*added the treport and tlabel to the makefile
*doc/funclist.txt
*update status of __reportform() and __labelform() functions
*include/rptdef.ch
*include file for TLabelForm and TReportForm
*source/rtl/tlabel.prg
+__labelform() function
*source/rtl/treport.prg
+__reportform() function
+tests/testlbl.prg
*test file for __labelform() function
+tests/testrpt.prg
*test file for __reportform() function
+tests/ee.frm
+tests/ee.lbl
*report and label files for the examples
20000213-16:15 GMT+1 Ryszard Glab <rglab@imid.med.pl>
*source/compiler/harbour.y

4
harbour/doc/funclist.txt
View File

@@ -299,7 +299,7 @@ __dbZap ;R;
__Dir ;R;
__Eject ;R;
__Keyboard ;R;
__LabelForm ;N;
__LabelForm ;R;
__MClear ;R;
__MenuTo ;R;
__MRelease ;R;
@@ -307,7 +307,7 @@ __MRestore ;R;
__MSave ;R;
__MXRelease ;R;
__Quit ;R;
__ReportForm ;N;
__ReportForm ;R;
__Run ;R;
__SetCentury ;R;
__SetFormat ;N;

172
harbour/include/rptdef.ch Normal file
View File

@@ -0,0 +1,172 @@
/*
* $Id$
*/
/*
* Harbour Project source code:
* Header file for TLabelForm and TReportForm Classes
*
* Copyright 1999 {list of individual authors and e-mail addresses}
* 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 of the License, or
* (at your option) any later version, with one exception:
*
* The exception is that if you link the Harbour Runtime Library (HRL)
* and/or the Harbour Virtual Machine (HVM) 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 HRL
* and/or HVM code into it.
*
* 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 program; if not, write to the Free Software
* Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA (or visit
* their web site at http://www.gnu.org/).
*
*/
#ifndef __RPTDEF_CH__
#define _RFRM_PAGENO 3 // "Page No."
#define _RFRM_SUBTOTAL 4 // "** Subtotal **"
#define _RFRM_SUBSUBTOTAL 5 // "* Subsubtotal *"
#define _RFRM_TOTAL 6 // "*** Total ***"
#define RPT_HEADER 1 // Array of header strings
#define RPT_WIDTH 2 // Numeric, report page width
#define RPT_LMARGIN 3 // Numeric, report page offset
#define RPT_RMARGIN 4 // NIL, Not used
#define RPT_LINES 5 // Numeric, number of lines per page
#define RPT_SPACING 6 // Numeric, single=1, double=2
#define RPT_BEJECT 7 // Logical, eject before 1st page, .T.=Yes .F.=No
#define RPT_AEJECT 8 // Logical, eject after last page, .T.=Yes .F.=No
#define RPT_PLAIN 9 // Logical, plain report, .T.=Yes .F.=No
#define RPT_SUMMARY 10 // Logical, no detail lines, .T.=Yes .F.=No
#define RPT_COLUMNS 11 // Array of Column arrays
#define RPT_GROUPS 12 // Array of Group arrays
#define RPT_HEADING 13 // Character, heading for the report
#define RPT_COUNT 13 // Number of elements in the Report array
// Column array definitions ( one array per column definition )
#define RCT_EXP 1 // Block, contains compiled column expression
#define RCT_TEXT 2 // Character, contains text column expression
#define RCT_TYPE 3 // Character, type of expression
#define RCT_HEADER 4 // Array of column heading strings
#define RCT_WIDTH 5 // Numeric, column width including decimals and
// decimal point
#define RCT_DECIMALS 6 // Numeric, number of decimal places
#define RCT_TOTAL 7 // Logical, total this column, .T.=Yes .F.=No
#define RCT_PICT 8 // Character, picture string
#define RCT_COUNT 8 // Number of elements in the Column array
// Group array definitions ( one array per group definition )
#define RGT_EXP 1 // Block, contains compiled group expression
#define RGT_TEXT 2 // Character, contains text group expression
#define RGT_TYPE 3 // Character, type of expression
#define RGT_HEADER 4 // Character, column heading string
#define RGT_AEJECT 5 // Logical, eject after group, .T.=Yes .F.=No
#define RGT_COUNT 5 // Number of elements in the Group array
#define SIZE_FILE_BUFF 1990 // Size of report file
#define SIZE_LENGTHS_BUFF 110
#define SIZE_OFFSETS_BUFF 110
#define SIZE_EXPR_BUFF 1440
#define SIZE_FIELDS_BUFF 300
#define SIZE_PARAMS_BUFF 24
// Definitions for offsets into the FILE_BUFF string
#define LENGTHS_OFFSET 5 // Start of expression length array
#define OFFSETS_OFFSET 115 // Start of expression position array
#define EXPR_OFFSET 225 // Start of expression data area
#define FIELDS_OFFSET 1665 // Start of report columns (fields)
#define PARAMS_OFFSET 1965 // Start of report parameters block
// These are offsets into the FIELDS_BUFF string to actual values
// Values are added to a block offset FLD_OFFSET that is moved in
// increments of 12
#define FIELD_WIDTH_OFFSET 1
#define FIELD_TOTALS_OFFSET 6
#define FIELD_DECIMALS_OFFSET 7
// These are offsets into FIELDS_BUFF which are used to 'point' into
// the EXPR_BUFF string which contains the textual data
#define FIELD_CONTENT_EXPR_OFFSET 9
#define FIELD_HEADER_EXPR_OFFSET 11
// These are actual offsets into the PARAMS_BUFF string which
// are used to 'point' into the EXPR_BUFF string
#define PAGE_HDR_OFFSET 1
#define GRP_EXPR_OFFSET 3
#define SUB_EXPR_OFFSET 5
#define GRP_HDR_OFFSET 7
#define SUB_HDR_OFFSET 9
// These are actual offsets into the PARAMS_BUFF string to actual values
#define PAGE_WIDTH_OFFSET 11
#define LNS_PER_PAGE_OFFSET 13
#define LEFT_MRGN_OFFSET 15
#define RIGHT_MGRN_OFFSET 17
#define COL_COUNT_OFFSET 19
#define DBL_SPACE_OFFSET 21
#define SUMMARY_RPT_OFFSET 22
#define PE_OFFSET 23
#define OPTION_OFFSET 24
// File error definitions
#define F_OK 0 // No error
#define F_EMPTY -3 // File is empty
#define F_ERROR -1 // Some kind of error
#define F_NOEXIST 2 // File does not exist
#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
#define __RPTDEF_CH__
#endif

16
harbour/makefile.bc
View File

@@ -178,8 +178,10 @@ HARBOUR_LIB_OBJS = $(OBJ_DIR)\achoice.obj \
$(OBJ_DIR)\text.obj \
$(OBJ_DIR)\tget.obj \
$(OBJ_DIR)\tgetlist.obj \
$(OBJ_DIR)\tlabel.obj \
$(OBJ_DIR)\tone.obj \
$(OBJ_DIR)\transfrm.obj \
$(OBJ_DIR)\treport.obj \
$(OBJ_DIR)\type.obj \
$(OBJ_DIR)\valtype.obj \
$(OBJ_DIR)\wait.obj \
@@ -846,6 +848,12 @@ $(OBJ_DIR)\tgetlist.c : $(RTL_DIR)\tgetlist.prg
$(OBJ_DIR)\tgetlist.obj : $(OBJ_DIR)\tgetlist.c
$(BCC_EXE) $(BCC_OPT) -c -I$(INCLUDE_DIR) -o$@ $**
tlib $(HARBOUR_LIB) -+$@,,
$(OBJ_DIR)\tlabel.c : $(RTL_DIR)\tlabel.prg
$(HARBOUR_EXE) $** -i$(INCLUDE_DIR) -n $(HARBOUR_OPT) -o$@
$(OBJ_DIR)\tlabel.obj : $(OBJ_DIR)\tlabel.c
$(BCC_EXE) $(BCC_OPT) -c -I$(INCLUDE_DIR) -o$@ $**
tlib $(HARBOUR_LIB) -+$@,,
$(OBJ_DIR)\tone.obj : $(RTL_DIR)\tone.c
$(BCC_EXE) $(BCC_OPT) -c -I$(INCLUDE_DIR) -o$@ $**
@@ -855,6 +863,13 @@ $(OBJ_DIR)\transfrm.obj : $(RTL_DIR)\transfrm.c
$(BCC_EXE) $(BCC_OPT) -c -I$(INCLUDE_DIR) -o$@ $**
tlib $(HARBOUR_LIB) -+$@,,
$(OBJ_DIR)\treport.c : $(RTL_DIR)\treport.prg
$(HARBOUR_EXE) $** -i$(INCLUDE_DIR) -n $(HARBOUR_OPT) -o$@
$(OBJ_DIR)\treport.obj : $(OBJ_DIR)\treport.c
$(BCC_EXE) $(BCC_OPT) -c -I$(INCLUDE_DIR) -o$@ $**
tlib $(HARBOUR_LIB) -+$@,,
$(OBJ_DIR)\type.obj : $(RTL_DIR)\type.c
$(BCC_EXE) $(BCC_OPT) -c -I$(INCLUDE_DIR) -o$@ $**
tlib $(HARBOUR_LIB) -+$@,,
@@ -1418,4 +1433,3 @@ $(OBJ_DIR)\gentrf.c : $(HBDOC_DIR)\gentrf.prg
$(OBJ_DIR)\gentrf.obj : $(OBJ_DIR)\gentrf.c
$(BCC_EXE) $(BCC_OPT) -c -I$(INCLUDE_DIR) -o$@ $**

456
harbour/source/rtl/tlabel.prg Normal file
View File

@@ -0,0 +1,456 @@
/*
* $Id$
*/
/*
* Harbour Project source code:
* TLabelForm class and __LabelForm()
*
* Copyright 2000 Luiz Rafael Culik <Culik@sl.conex.net>
* 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 of the License, or
* (at your option) any later version, with one exception:
*
* The exception is that if you link the Harbour Runtime Library (HRL)
* and/or the Harbour Virtual Machine (HVM) 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 HRL
* and/or HVM code into it.
*
* 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 program; if not, write to the Free Software
* Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA (or visit
* their web site at http://www.gnu.org/).
*
*/
#include 'hbclass.ch'
#include 'inkey.ch'
#include 'rptdef.ch'
#define _LF_SAMPLES 2 // "Do you want more samples?"
#define _LF_YN 12 // "Y/N"
CLASS TLabelForm
DATA aLabelData AS {}
DATA aBandToPrint
DATA cBlank AS ""
DATA lOneMoreBand AS .T.
DATA nCurrentCol // 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 TLabelForm
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 TLabelForm
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 TLabelForm
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 TLabelForm
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 TLabelForm():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

1284
harbour/source/rtl/treport.prg Normal file
View File

File diff suppressed because it is too large Load Diff

BIN
harbour/tests/ee.frm Normal file
View File

Binary file not shown.

BIN
harbour/tests/ee.lbl Normal file
View File

Binary file not shown.

10
harbour/tests/testlbl.prg Normal file
View File

@@ -0,0 +1,10 @@
FUNCTION MAIN()
USE Test New
LABEL FORM EE
USE
RETURN NIL

9
harbour/tests/testrpt.prg Normal file
View File

@@ -0,0 +1,9 @@
FUNCTION() MAIN
USE Test New
Report FORM EE
USE
RETURN NIL