diff --git a/harbour/ChangeLog b/harbour/ChangeLog index fe53851d5c..bd696b6171 100644 --- a/harbour/ChangeLog +++ b/harbour/ChangeLog @@ -1,3 +1,31 @@ +20000213-23:59 GMT+1 Victor Szakats + ! makefile.bc + ! Fixed again. + * source/rtl/Makefile + + treport.prg and tlabel.prg added. + * tests/testrpt.prg + tests/testlbl.prg + ! CVS ID added. + * include/rptdef.ch + include/hbrptlbl.ch + include/Makefile + source/rtl/tlabel.prg + source/rtl/treport.prg + ! rptdef.ch renamed to hbrptlbl.ch + + hbrptlbl.ch added to Makefile + ! Small corrections to hbrptlbl.ch + + Indentation fixed. + ! .FRM/.LBL changed to lowercase. + ! RETURNs without value fixed. + ! RG_ changed to RGT_ + + #include "error.ch" added. + ! One mistyped variable name fixed. + * "=" changed to ":=" and "==" + * source/rtl/fm.c + ! // comments changed to /**/ + * include/hbtrace.h + ! Minor correction. + 20000213-15:50 GMT-3 Luiz Rafael Culik *makefile.bc *added the treport and tlabel to the makefile @@ -16,6 +44,7 @@ +tests/ee.frm +tests/ee.lbl *report and label files for the examples + 20000213-16:15 GMT+1 Ryszard Glab *source/compiler/harbour.y diff --git a/harbour/include/Makefile b/harbour/include/Makefile index 5c243eeba0..2400406e66 100644 --- a/harbour/include/Makefile +++ b/harbour/include/Makefile @@ -51,6 +51,7 @@ PRG_HEADERS=\ hbextern.ch \ hbmemory.ch \ hbmemvar.ch \ + hbrptlbl.ch \ hbsetup.ch \ inkey.ch \ memoedit.ch \ diff --git a/harbour/include/hbrptlbl.ch b/harbour/include/hbrptlbl.ch new file mode 100644 index 0000000000..707d6286a8 --- /dev/null +++ b/harbour/include/hbrptlbl.ch @@ -0,0 +1,175 @@ +/* + * $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 HB_RPTLBL_CH_ +#define HB_RPTLBL_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 _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 + +#endif /* HB_RPTLBL_CH_ */ + diff --git a/harbour/include/hbtrace.h b/harbour/include/hbtrace.h index 333fc61966..3ef4133203 100644 --- a/harbour/include/hbtrace.h +++ b/harbour/include/hbtrace.h @@ -121,7 +121,7 @@ * filename/linenum information - this is usefull if we want to * trace the source of unreleased memory blocks */ -#define HB_ECHO_STEALTH( l, x ) do \ +#define HB_ECHO_STEALTH( l, x ) do \ { \ if( hb_tr_level() >= l ) \ { \ diff --git a/harbour/include/rptdef.ch b/harbour/include/rptdef.ch deleted file mode 100644 index eccdee1aa6..0000000000 --- a/harbour/include/rptdef.ch +++ /dev/null @@ -1,172 +0,0 @@ -/* - * $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 diff --git a/harbour/makefile.bc b/harbour/makefile.bc index 09754c1ef6..346906f7d8 100644 --- a/harbour/makefile.bc +++ b/harbour/makefile.bc @@ -4,13 +4,33 @@ # makefile for Borland C/C++ compilers - # Borland C/C++ (Windows 32 bits) - BCC_EXE = bcc32 - TASM_EXE = tasm32 - OBJ_DIR = obj\b32 - LIB_DIR = lib\b32 - # Borland C/C++ 5.x - BCC_OPT = -O2 -DHARBOUR_USE_WIN_GTAPI +!if $d(B16) + +# Borland C/C++ (DOS 16 bits) +# Don't indent these. +BCC_OPT = -mh -DHARBOUR_USE_DOS_GTAPI +BCC_EXE = bcc +TASM_EXE = tasm +OBJ_DIR = obj\b16 +LIB_DIR = lib\b16 + +!else + +# Borland C/C++ (Windows 32 bits) +BCC_EXE = bcc32 +TASM_EXE = tasm32 +OBJ_DIR = obj\b32 +LIB_DIR = lib\b32 + +!if $d(B40) +# Borland C/C++ 4.x (Avoid optimizer bug) +BCC_OPT = -DHARBOUR_USE_WIN_GTAPI +!else +# Borland C/C++ 5.x +BCC_OPT = -O2 -DHARBOUR_USE_WIN_GTAPI +!endif + +!endif HARBOUR_OPT = -q @@ -322,26 +342,26 @@ $(OBJ_DIR)\hbpplib.obj : $(PP_DIR)\hbpplib.c # $(HARBOUR_EXE) : $(HARBOUR_EXE_OBJS) - echo $(BCC_OPT) > temp.bld - echo -e$(HARBOUR_EXE) >> temp.bld - echo -I$(INCLUDE_DIR) >> temp.bld - echo $(OBJ_DIR)\harbour.obj >> temp.bld - echo $(OBJ_DIR)\harboury.obj >> temp.bld - echo $(OBJ_DIR)\harbourl.obj >> temp.bld - echo $(OBJ_DIR)\cmdcheck.obj >> temp.bld - echo $(OBJ_DIR)\hbusage.obj >> temp.bld - echo $(OBJ_DIR)\hbgenerr.obj >> temp.bld - echo $(OBJ_DIR)\hbpcode.obj >> temp.bld - echo $(OBJ_DIR)\genc.obj >> temp.bld - echo $(OBJ_DIR)\genjava.obj >> temp.bld - echo $(OBJ_DIR)\genpas.obj >> temp.bld - echo $(OBJ_DIR)\genrc.obj >> temp.bld - echo $(OBJ_DIR)\genhrb.obj >> temp.bld - echo $(OBJ_DIR)\expropt.obj >> temp.bld - echo $(OBJ_DIR)\hbfunchk.obj >> temp.bld - echo $(COMMON_LIB) $(PP_LIB) >> temp.bld - $(BCC_EXE) @temp.bld - del temp.bld + echo $(BCC_OPT) > make.tmp + echo -e$(HARBOUR_EXE) >> make.tmp + echo -I$(INCLUDE_DIR) >> make.tmp + echo $(OBJ_DIR)\harbour.obj >> make.tmp + echo $(OBJ_DIR)\harboury.obj >> make.tmp + echo $(OBJ_DIR)\harbourl.obj >> make.tmp + echo $(OBJ_DIR)\cmdcheck.obj >> make.tmp + echo $(OBJ_DIR)\hbusage.obj >> make.tmp + echo $(OBJ_DIR)\hbgenerr.obj >> make.tmp + echo $(OBJ_DIR)\hbpcode.obj >> make.tmp + echo $(OBJ_DIR)\genc.obj >> make.tmp + echo $(OBJ_DIR)\genjava.obj >> make.tmp + echo $(OBJ_DIR)\genpas.obj >> make.tmp + echo $(OBJ_DIR)\genrc.obj >> make.tmp + echo $(OBJ_DIR)\genhrb.obj >> make.tmp + echo $(OBJ_DIR)\expropt.obj >> make.tmp + echo $(OBJ_DIR)\hbfunchk.obj >> make.tmp + echo $(COMMON_LIB) $(PP_LIB) >> make.tmp + $(BCC_EXE) @make.tmp + del make.tmp $(OBJ_DIR)\harbour.obj : $(COMPILER_DIR)\harbour.c $(BCC_EXE) $(BCC_OPT) -c -I$(INCLUDE_DIR) -o$@ $** @@ -397,13 +417,13 @@ $(OBJ_DIR)\hbfunchk.obj : $(COMPILER_DIR)\hbfunchk.c $(PP_EXE) : $(PP_LIB_OBJS) $(COMMON_LIB_OBJS) $(BCC_EXE) $(BCC_OPT) -c -I$(INCLUDE_DIR) -o$(OBJ_DIR)\hbpp.obj $(PP_DIR)\stdalone\hbpp.c - echo $(BCC_OPT) > temp.bld - echo -e$(PP_EXE) >> temp.bld - echo -I$(INCLUDE_DIR) >> temp.bld - echo $(OBJ_DIR)\hbpp.obj >> temp.bld - echo $(COMMON_LIB) $(PP_LIB) >> temp.bld - $(BCC_EXE) @temp.bld - del temp.bld + echo $(BCC_OPT) > make.tmp + echo -e$(PP_EXE) >> make.tmp + echo -I$(INCLUDE_DIR) >> make.tmp + echo $(OBJ_DIR)\hbpp.obj >> make.tmp + echo $(COMMON_LIB) $(PP_LIB) >> make.tmp + $(BCC_EXE) @make.tmp + del make.tmp # # harbour.lib @@ -1226,22 +1246,22 @@ $(RUNNER_EXE) : $(RUNNER_DIR)\stdalone\external.prg \ $(HARBOUR_EXE) -i$(INCLUDE_DIR) -i$(RUNNER_DIR)\stdalone -n $(HARBOUR_OPT) -o$(OBJ_DIR)\ $(RUNNER_DIR)\stdalone\hbrun.prg $(BCC_EXE) $(BCC_OPT) -c -I$(INCLUDE_DIR) -o$(OBJ_DIR)\hbrun.obj $(OBJ_DIR)\hbrun.c - echo $(BCC_OPT) > temp.bld - echo -e$(RUNNER_EXE) >> temp.bld - echo -I$(INCLUDE_DIR) >> temp.bld - echo $(OBJ_DIR)\hbrun.obj >> temp.bld - echo $(OBJ_DIR)\external.obj >> temp.bld - echo $(HARBOUR_LIB) >> temp.bld - echo $(PP_LIB) >> temp.bld - echo $(COMMON_LIB) >> temp.bld - echo $(TERMINAL_LIB) >> temp.bld - echo $(MACRO_LIB) >> temp.bld - echo $(TOOLS_LIB) >> temp.bld - echo $(RUNNER_LIB) >> temp.bld - echo $(DBFNTX_LIB) >> temp.bld - echo $(DBFCDX_LIB) >> temp.bld - $(BCC_EXE) @temp.bld - del temp.bld + echo $(BCC_OPT) > make.tmp + echo -e$(RUNNER_EXE) >> make.tmp + echo -I$(INCLUDE_DIR) >> make.tmp + echo $(OBJ_DIR)\hbrun.obj >> make.tmp + echo $(OBJ_DIR)\external.obj >> make.tmp + echo $(HARBOUR_LIB) >> make.tmp + echo $(PP_LIB) >> make.tmp + echo $(COMMON_LIB) >> make.tmp + echo $(TERMINAL_LIB) >> make.tmp + echo $(MACRO_LIB) >> make.tmp + echo $(TOOLS_LIB) >> make.tmp + echo $(RUNNER_LIB) >> make.tmp + echo $(DBFNTX_LIB) >> make.tmp + echo $(DBFCDX_LIB) >> make.tmp + $(BCC_EXE) @make.tmp + del make.tmp # # debug.lib @@ -1267,28 +1287,28 @@ $(OBJ_DIR)\tbrwtext.obj : $(OBJ_DIR)\tbrwtext.c # $(REGRESS_EXE) : $(REGRESS_EXE_OBJS) - echo $(BCC_OPT) > temp.bld - echo -e$(BIN_DIR)\rt_main.exe >> temp.bld - echo -I$(INCLUDE_DIR) >> temp.bld - echo $(OBJ_DIR)\rt_main.obj >> temp.bld - echo $(OBJ_DIR)\rt_hvm.obj >> temp.bld - echo $(OBJ_DIR)\rt_math.obj >> temp.bld - echo $(OBJ_DIR)\rt_date.obj >> temp.bld - echo $(OBJ_DIR)\rt_str.obj >> temp.bld - echo $(OBJ_DIR)\rt_trans.obj >> temp.bld - echo $(OBJ_DIR)\rt_array.obj >> temp.bld - echo $(OBJ_DIR)\rt_file.obj >> temp.bld - echo $(OBJ_DIR)\rt_misc.obj >> temp.bld - echo $(HARBOUR_LIB) >> temp.bld - echo $(PP_LIB) >> temp.bld - echo $(COMMON_LIB) >> temp.bld - echo $(TERMINAL_LIB) >> temp.bld - echo $(MACRO_LIB) >> temp.bld - echo $(TOOLS_LIB) >> temp.bld - echo $(DBFNTX_LIB) >> temp.bld - echo $(DBFCDX_LIB) >> temp.bld - $(BCC_EXE) @temp.bld - del temp.bld + echo $(BCC_OPT) > make.tmp + echo -e$(BIN_DIR)\rt_main.exe >> make.tmp + echo -I$(INCLUDE_DIR) >> make.tmp + echo $(OBJ_DIR)\rt_main.obj >> make.tmp + echo $(OBJ_DIR)\rt_hvm.obj >> make.tmp + echo $(OBJ_DIR)\rt_math.obj >> make.tmp + echo $(OBJ_DIR)\rt_date.obj >> make.tmp + echo $(OBJ_DIR)\rt_str.obj >> make.tmp + echo $(OBJ_DIR)\rt_trans.obj >> make.tmp + echo $(OBJ_DIR)\rt_array.obj >> make.tmp + echo $(OBJ_DIR)\rt_file.obj >> make.tmp + echo $(OBJ_DIR)\rt_misc.obj >> make.tmp + echo $(HARBOUR_LIB) >> make.tmp + echo $(PP_LIB) >> make.tmp + echo $(COMMON_LIB) >> make.tmp + echo $(TERMINAL_LIB) >> make.tmp + echo $(MACRO_LIB) >> make.tmp + echo $(TOOLS_LIB) >> make.tmp + echo $(DBFNTX_LIB) >> make.tmp + echo $(DBFCDX_LIB) >> make.tmp + $(BCC_EXE) @make.tmp + del make.tmp $(OBJ_DIR)\rt_main.c : $(REGRESS_DIR)\rt_main.prg $(HARBOUR_EXE) $** -i$(INCLUDE_DIR) -n $(HARBOUR_OPT) -o$@ @@ -1349,27 +1369,27 @@ $(OBJ_DIR)\rt_misc.obj : $(OBJ_DIR)\rt_misc.c # $(HBDOC_EXE) : $(HBDOC_EXE_OBJS) - echo $(BCC_OPT) > temp.bld - echo -e$(BIN_DIR)\hbdoc.exe >> temp.bld - echo -I$(INCLUDE_DIR) >> temp.bld - echo $(OBJ_DIR)\hbdoc.obj >> temp.bld - echo $(OBJ_DIR)\genasc.obj >> temp.bld - echo $(OBJ_DIR)\genhpc.obj >> temp.bld - echo $(OBJ_DIR)\genhtm.obj >> temp.bld - echo $(OBJ_DIR)\genng.obj >> temp.bld - echo $(OBJ_DIR)\genos2.obj >> temp.bld - echo $(OBJ_DIR)\genrtf.obj >> temp.bld - echo $(OBJ_DIR)\gentrf.obj >> temp.bld - echo $(HARBOUR_LIB) >> temp.bld - echo $(PP_LIB) >> temp.bld - echo $(COMMON_LIB) >> temp.bld - echo $(TERMINAL_LIB) >> temp.bld - echo $(MACRO_LIB) >> temp.bld - echo $(TOOLS_LIB) >> temp.bld - echo $(DBFNTX_LIB) >> temp.bld - echo $(DBFCDX_LIB) >> temp.bld - $(BCC_EXE) @temp.bld - del temp.bld + echo $(BCC_OPT) > make.tmp + echo -e$(BIN_DIR)\hbdoc.exe >> make.tmp + echo -I$(INCLUDE_DIR) >> make.tmp + echo $(OBJ_DIR)\hbdoc.obj >> make.tmp + echo $(OBJ_DIR)\genasc.obj >> make.tmp + echo $(OBJ_DIR)\genhpc.obj >> make.tmp + echo $(OBJ_DIR)\genhtm.obj >> make.tmp + echo $(OBJ_DIR)\genng.obj >> make.tmp + echo $(OBJ_DIR)\genos2.obj >> make.tmp + echo $(OBJ_DIR)\genrtf.obj >> make.tmp + echo $(OBJ_DIR)\gentrf.obj >> make.tmp + echo $(HARBOUR_LIB) >> make.tmp + echo $(PP_LIB) >> make.tmp + echo $(COMMON_LIB) >> make.tmp + echo $(TERMINAL_LIB) >> make.tmp + echo $(MACRO_LIB) >> make.tmp + echo $(TOOLS_LIB) >> make.tmp + echo $(DBFNTX_LIB) >> make.tmp + echo $(DBFCDX_LIB) >> make.tmp + $(BCC_EXE) @make.tmp + del make.tmp $(OBJ_DIR)\hbdoc.c : $(HBDOC_DIR)\hbdoc.prg $(HARBOUR_EXE) $** -i$(INCLUDE_DIR) -n $(HARBOUR_OPT) -o$@ diff --git a/harbour/source/rtl/Makefile b/harbour/source/rtl/Makefile index 0e088ef5aa..53c1b878be 100644 --- a/harbour/source/rtl/Makefile +++ b/harbour/source/rtl/Makefile @@ -92,6 +92,8 @@ PRG_SOURCES=\ text.prg \ tget.prg \ tgetlist.prg \ + tlabel.prg \ + treport.prg \ wait.prg \ xsavescr.prg \ diff --git a/harbour/source/rtl/fm.c b/harbour/source/rtl/fm.c index 3f3aa5dd45..2dee799462 100644 --- a/harbour/source/rtl/fm.c +++ b/harbour/source/rtl/fm.c @@ -71,11 +71,12 @@ #define HB_TR_LEVEL HB_TR_ERROR #endif -//#if HB_TR_LEVEL >= HB_TR_DEBUG -//extern char * hb_tr_file_; -//extern int hb_tr_line_; -//#endif - +/* +#if HB_TR_LEVEL >= HB_TR_DEBUG + extern char * hb_tr_file_; + extern int hb_tr_line_; +#endif +*/ #ifdef HB_FM_STATISTICS diff --git a/harbour/source/rtl/tlabel.prg b/harbour/source/rtl/tlabel.prg index 635060292a..1194261095 100644 --- a/harbour/source/rtl/tlabel.prg +++ b/harbour/source/rtl/tlabel.prg @@ -33,26 +33,26 @@ * */ -#include 'hbclass.ch' -#include 'inkey.ch' -#include 'rptdef.ch' -#define _LF_SAMPLES 2 // "Do you want more samples?" -#define _LF_YN 12 // "Y/N" - +#include "hbclass.ch" +#include "hbrptlbl.ch" +#include "error.ch" +#include "inkey.ch" 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) + 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 @@ -61,10 +61,11 @@ METHOD New( cLBLName, lPrinter, cAltFile, lNoConsole, bFor, ; LOCAL cExtraFile, lExtraState // EXTRA file status LOCAL xBreakVal, lBroke := .F. LOCAL err - Local OldMargin + LOCAL OldMargin LOCAL nLen - ::aBandToPrint:={} // ARRAY(5) - ::nCurrentCol := 1 + + ::aBandToPrint:={} // ARRAY(5) + ::nCurrentCol := 1 // Resolve parameters IF cLBLName == NIL err := ErrorNew() @@ -75,19 +76,19 @@ METHOD New( cLBLName, lPrinter, cAltFile, lNoConsole, bFor, ; ELSE IF AT( ".", cLBLName ) == 0 - cLBLName := TRIM( cLBLName ) + ".LBL" + 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 ) @@ -95,50 +96,50 @@ METHOD New( cLBLName, lPrinter, cAltFile, lNoConsole, bFor, ; 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 ] ) + // 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 @@ -147,28 +148,28 @@ METHOD New( cLBLName, lPrinter, cAltFile, lNoConsole, bFor, ; ::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 + 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 ] ) @@ -196,7 +197,7 @@ METHOD ExecuteLabel() CLASS TLabelForm NEXT ASIZE( aBuffer, LEN( ::aLabelData[ LBL_FIELDS ] ) ) - + // Add aBuffer to ::aBandToPrint FOR nField := 1 TO LEN( ::aLabelData[ LBL_FIELDS ] ) IF aBuffer[ nField ] == NIL @@ -205,18 +206,18 @@ METHOD ExecuteLabel() CLASS TLabelForm ::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 + // 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 ) } ) @@ -227,27 +228,27 @@ METHOD ExecuteLabel() CLASS TLabelForm 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 ] ) +; @@ -255,10 +256,10 @@ METHOD SampleLabels() CLASS TLabelForm ::aLabelData[ LBL_WIDTH ] ) + ; SPACE( ::aLabelData[ LBL_SPACES ] ), ; ::aLabelData[ LBL_ACROSS ] ) ) - + // Prints sample labels DO WHILE lMoreSamples - + // Print the samples AEVAL( aBand, { | BandLine | PrintIt( BandLine ) } ) @@ -268,7 +269,7 @@ METHOD SampleLabels() CLASS TLabelForm PrintIt() NEXT nField ENDIF - + // Prompt for more @ ROW(), 0 SAY NationMsg(_LF_SAMPLES)+" ("+Nationmsg(_LF_YN)+")" nGetKey := INKEY(0) @@ -283,8 +284,8 @@ METHOD SampleLabels() CLASS TLabelForm lMoreSamples := .F. ENDIF ENDDO - RETURN Self + RETURN Self METHOD LoadLabel( cLblFile ) CLASS TLabelForm LOCAL i, j := 0 // Counters @@ -386,9 +387,9 @@ METHOD LoadLabel( cLblFile ) CLASS TLabelForm // Compression option AADD( aLabel[ LBL_FIELDS, i ], .T. ) - ELSE + ELSE - AADD( aLabel[ LBL_FIELDS ], NIL ) + AADD( aLabel[ LBL_FIELDS ], NIL ) ENDIF @@ -396,18 +397,18 @@ METHOD LoadLabel( cLblFile ) CLASS TLabelForm // Close file FCLOSE( nHandle ) - nFileError = FERROR() + nFileError := FERROR() ENDIF - RETURN( aLabel ) + 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 ) + RETURN TLabelForm():New( cLBLName, lPrinter, cAltFile, lNoConsole, bFor, ; + bWhile, nNext, nRecord, lRest, lSample ) STATIC PROCEDURE PrintIt( cString ) @@ -424,16 +425,16 @@ 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 ) + DO WHILE LEN(cList) <> 0 nPos := AT(cDelimiter, cList) - IF ( nPos == 0 ) + IF nPos == 0 nPos := LEN(cList) ENDIF @@ -449,8 +450,9 @@ STATIC FUNCTION ListAsArray( cList, cDelimiter ) ENDDO - IF ( lDelimLast ) + IF lDelimLast AADD(aList, "") ENDIF RETURN aList // Return the array + diff --git a/harbour/source/rtl/treport.prg b/harbour/source/rtl/treport.prg index 3639200129..8bd8e3ddcc 100644 --- a/harbour/source/rtl/treport.prg +++ b/harbour/source/rtl/treport.prg @@ -33,37 +33,40 @@ * */ - -#include 'hbclass.ch' -#include 'inkey.ch' -#include 'rptdef.ch' +#include "hbclass.ch" +#include "hbrptlbl.ch" +#include "error.ch" +#include "inkey.ch" CLASS TReportForm -DATA aReportData AS {} -DATA aReportTotals AS {} -DATA aGroupTotals AS {} -DATA nPageNumber -DATA nLinesLeft -DATA lFirstPass -DATA lFormFeeds -DATA nMaxLinesAvail -DATA cExprBuff -DATA cOffsetsBuff -DATA cLengthsBuff -METHOD NEW(cFrmName,lPrinter,cAltFile,lNoConsole,bFor,bWhile,nNext,nRecord,; - lRest,lPlain,cHeading,lBEject,lSummary) -METHOD ExecuteReport() -METHOD ReportHeader() -METHOD EjectPage() -METHOD PrintIt(cString) -METHOD LoadReportFile(cFile) -METHOD GetExpr( nPointer ) -METHOD GetColumn( cFieldsBuffer, nOffset ) + DATA aReportData AS {} + DATA aReportTotals AS {} + DATA aGroupTotals AS {} + DATA nPageNumber + DATA nLinesLeft + DATA lFirstPass + DATA lFormFeeds + DATA nMaxLinesAvail + DATA cExprBuff + DATA cOffsetsBuff + DATA cLengthsBuff + + METHOD NEW(cFrmName,lPrinter,cAltFile,lNoConsole,bFor,bWhile,nNext,nRecord,; + lRest,lPlain,cHeading,lBEject,lSummary) + METHOD ExecuteReport() + METHOD ReportHeader() + METHOD EjectPage() + METHOD PrintIt(cString) + METHOD LoadReportFile(cFile) + METHOD GetExpr( nPointer ) + METHOD GetColumn( cFieldsBuffer, nOffset ) + ENDCLASS METHOD NEW(cFrmName,lPrinter,cAltFile,lNoConsole,bFor,bWhile,nNext,nRecord,; lRest,lPlain,cHeading,lBEject,lSummary) CLASS TReportForm + LOCAL lPrintOn, lConsoleOn // Status of PRINTER and CONSOLE LOCAL cExtraFile, lExtraState // Status of EXTRA LOCAL nCol, nGroup @@ -82,37 +85,37 @@ METHOD NEW(cFrmName,lPrinter,cAltFile,lNoConsole,bFor,bWhile,nNext,nRecord,; Eval(ErrorBlock(), err) ELSE IF AT( ".", cFRMName ) == 0 - cFRMName := TRIM( cFRMName ) + ".FRM" + cFRMName := TRIM( cFRMName ) + ".frm" ENDIF ENDIF #ifdef OLDCODE IF lPrinter == NIL - lPrinter := .F. + lPrinter := .F. ENDIF #endif IF cHeading == NIL - cHeading := "" + cHeading := "" ENDIF // Set output devices lPrintOn := IF( lPrinter, SET( _SET_PRINTER, lPrinter ), ; - SET( _SET_PRINTER ) ) + SET( _SET_PRINTER ) ) - lConsoleOn := IF( lNoConsole, SET( _SET_CONSOLE, .F.), ; - SET( _SET_CONSOLE) ) + lConsoleOn := IF( lNoConsole, SET( _SET_CONSOLE, .F.), ; + SET( _SET_CONSOLE) ) IF lPrinter // To the printer - ::lFormFeeds := .T. + ::lFormFeeds := .T. ELSE - ::lFormFeeds := .F. + ::lFormFeeds := .F. ENDIF IF (!Empty(cAltFile)) // To file - lExtraState := SET( _SET_EXTRA, .T. ) - cExtraFile := SET( _SET_EXTRAFILE, cAltFile ) + lExtraState := SET( _SET_EXTRA, .T. ) + cExtraFile := SET( _SET_EXTRAFILE, cAltFile ) ENDIF @@ -123,21 +126,21 @@ METHOD NEW(cFrmName,lPrinter,cAltFile,lNoConsole,bFor,bWhile,nNext,nRecord,; // Modify ::aReportData based on the report parameters IF lSummary == .T. // Set the summary only flag - ::aReportData[ RPT_SUMMARY ] := lSummary - ENDIF - IF lBEject != NIL .AND. lBEject - ::aReportData[ RPT_BEJECT ] := .F. - ENDIF - IF lPlain // Set plain report flag + ::aReportData[ RPT_SUMMARY ] := lSummary + ENDIF + IF lBEject != NIL .AND. lBEject + ::aReportData[ RPT_BEJECT ] := .F. + ENDIF + IF lPlain // Set plain report flag ::aReportData[ RPT_PLAIN ] := .T. - cHeading := "" + cHeading := "" ::lFormFeeds := .F. - ENDIF + ENDIF ::aReportData[ RPT_HEADING ] := cHeading - // Add to the left margin if a SET MARGIN has been defined - // NOTE: uncommenting this line will cause REPORT FORM to respect - // SET MARGIN to screen/to file, but double the margin TO PRINT + // Add to the left margin if a SET MARGIN has been defined + // NOTE: uncommenting this line will cause REPORT FORM to respect + // SET MARGIN to screen/to file, but double the margin TO PRINT // ::aReportData[ RPT_LMARGIN ] += SET( _SET_MARGIN ) ::nPageNumber := 1 // Set the initial page number @@ -146,143 +149,143 @@ METHOD NEW(cFrmName,lPrinter,cAltFile,lNoConsole,bFor,bWhile,nNext,nRecord,; ::nLinesLeft := ::aReportData[ RPT_LINES ] - // Check to see if a "before report" eject, or TO FILE has been specified + // Check to see if a "before report" eject, or TO FILE has been specified IF ::aReportData[ RPT_BEJECT ] ::EjectPage() - ENDIF + ENDIF - // Generate the initial report header manually (in case there are no - // records that match the report scope) + // Generate the initial report header manually (in case there are no + // records that match the report scope) ::ReportHeader() // Initialize ::aReportTotals to track both group and report totals, then - // set the column total elements to 0 if they are to be totaled, otherwise - // leave them NIL + // set the column total elements to 0 if they are to be totaled, otherwise + // leave them NIL ::aReportTotals := ARRAY( LEN(::aReportData[RPT_GROUPS]) + 1, ; LEN(::aReportData[RPT_COLUMNS]) ) - // Column total elements + // Column total elements FOR nCol := 1 TO LEN(::aReportData[RPT_COLUMNS]) IF ::aReportData[RPT_COLUMNS,nCol,RCT_TOTAL] FOR nGroup := 1 TO LEN(::aReportTotals) ::aReportTotals[nGroup,nCol] := 0 - NEXT - ENDIF - NEXT + NEXT + ENDIF + NEXT // Initialize ::aGroupTotals as an array ::aGroupTotals := ARRAY( LEN(::aReportData[RPT_GROUPS]) ) - // Execute the actual report based on matching records + // Execute the actual report based on matching records DBEval( { || ::ExecuteReport() }, bFor, bWhile, nNext, nRecord, lRest ) - // Generate any totals that may have been identified - // Make a pass through all the groups + // Generate any totals that may have been identified + // Make a pass through all the groups FOR nGroup := LEN(::aReportData[RPT_GROUPS]) TO 1 STEP -1 - // make sure group has subtotals - lAnySubTotals := .F. + // make sure group has subtotals + lAnySubTotals := .F. FOR nCol := 1 TO LEN(::aReportData[RPT_COLUMNS]) IF ::aReportData[RPT_COLUMNS,nCol,RCT_TOTAL] - lAnySubTotals := .T. - EXIT // NOTE - ENDIF - NEXT + lAnySubTotals := .T. + EXIT // NOTE + ENDIF + NEXT - IF !lAnySubTotals - LOOP // NOTE - ENDIF + IF !lAnySubTotals + LOOP // NOTE + ENDIF - // Check to see if we need to eject the page + // Check to see if we need to eject the page IF ::nLinesLeft < 2 ::EjectPage() IF ::aReportData[ RPT_PLAIN ] ::nLinesLeft := 1000 - ELSE + ELSE ::ReportHeader() - ENDIF - ENDIF + ENDIF + ENDIF - // Print the first line + // Print the first line ::PrintIt( SPACE(::aReportData[RPT_LMARGIN]) + ; IF(nGroup==1,NationMsg(_RFRM_SUBTOTAL),; NationMsg(_RFRM_SUBSUBTOTAL) ) ) - // Print the second line + // Print the second line QQOUT( SPACE(::aReportData[RPT_LMARGIN]) ) FOR nCol := 1 TO LEN(::aReportData[RPT_COLUMNS]) - IF nCol > 1 - QQOUT( " " ) - ENDIF + IF nCol > 1 + QQOUT( " " ) + ENDIF IF ::aReportData[RPT_COLUMNS,nCol,RCT_TOTAL] QQOUT( TRANSFORM(::aReportTotals[nGroup+1,nCol], ; ::aReportData[RPT_COLUMNS,nCol,RCT_PICT]) ) - ELSE + ELSE QQOUT( SPACE(::aReportData[RPT_COLUMNS,nCol,RCT_WIDTH]) ) - ENDIF - NEXT + ENDIF + NEXT - // Send a cr/lf for the last line - QOUT() + // Send a cr/lf for the last line + QOUT() - NEXT + NEXT - // Any report totals? - lAnyTotals := .F. + // Any report totals? + lAnyTotals := .F. FOR nCol := 1 TO LEN(::aReportData[RPT_COLUMNS]) IF ::aReportData[RPT_COLUMNS,nCol,RCT_TOTAL] - lAnyTotals := .T. - EXIT - ENDIF - NEXT nCol + lAnyTotals := .T. + EXIT + ENDIF + NEXT nCol - IF lAnyTotals + IF lAnyTotals - // Check to see if we need to eject the page - IF ::nLinesLeft < 2 - ::EjectPage() - IF ::aReportData[ RPT_PLAIN ] - ::nLinesLeft := 1000 - ELSE - ::ReportHeader() - ENDIF - ENDIF + // Check to see if we need to eject the page + IF ::nLinesLeft < 2 + ::EjectPage() + IF ::aReportData[ RPT_PLAIN ] + ::nLinesLeft := 1000 + ELSE + ::ReportHeader() + ENDIF + ENDIF - // Print the first line + // Print the first line ::PrintIt( SPACE(::aReportData[RPT_LMARGIN]) + NationMsg(_RFRM_TOTAL ) ) - // Print the second line + // Print the second line QQOUT( SPACE(::aReportData[RPT_LMARGIN]) ) FOR nCol := 1 TO LEN(::aReportData[RPT_COLUMNS]) - IF nCol > 1 - QQOUT( " " ) - ENDIF + IF nCol > 1 + QQOUT( " " ) + ENDIF IF ::aReportData[RPT_COLUMNS,nCol,RCT_TOTAL] QQOUT( TRANSFORM(::aReportTotals[1,nCol], ; ::aReportData[RPT_COLUMNS,nCol,RCT_PICT]) ) - ELSE + ELSE QQOUT( SPACE(::aReportData[RPT_COLUMNS,nCol,RCT_WIDTH]) ) - ENDIF - NEXT nCol + ENDIF + NEXT nCol - // Send a cr/lf for the last line - QOUT() + // Send a cr/lf for the last line + QOUT() - ENDIF + ENDIF - // Check to see if an "after report" eject, or TO FILE has been specified + // Check to see if an "after report" eject, or TO FILE has been specified IF ::aReportData[ RPT_AEJECT ] ::EjectPage() - ENDIF + ENDIF RECOVER USING xBreakVal - lBroke := .T. + lBroke := .T. END SEQUENCE @@ -302,16 +305,16 @@ METHOD NEW(cFrmName,lPrinter,cAltFile,lNoConsole,bFor,bWhile,nNext,nRecord,; 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 ) + SET( _SET_EXTRAFILE, cExtraFile ) + SET( _SET_EXTRA, lExtraState ) ENDIF IF lBroke - // keep the break value going - BREAK xBreakVal + // keep the break value going + BREAK xBreakVal END - RETURN + RETURN NIL METHOD PrintIt(cString) CLASS TReportForm @@ -321,15 +324,16 @@ METHOD PrintIt(cString) CLASS TReportForm QQOUT(cString) QOUT() -RETURN Self + + RETURN Self METHOD EjectPage() CLASS TReportForm - IF ::lFormFeeds + IF ::lFormFeeds EJECT ENDIF -RETURN Self + RETURN Self METHOD ReportHeader() CLASS TReportForm @@ -356,12 +360,12 @@ METHOD ReportHeader() CLASS TReportForm nLinesInHeader:=MAX( XMLCOUNT( LTRIM( aTempPgHeader[ nLine ] ) , ; nHeadingLength),1) - FOR nHeadLine := 1 to nLinesInHeader - AADD( aPageHeader, SPACE( 15 ) + ; - PADC( TRIM( XMEMOLINE( LTRIM( aTempPgHeader[ nLine ]),; - nHeadingLength,nHeadLine)), nHeadingLength)) + FOR nHeadLine := 1 to nLinesInHeader + AADD( aPageHeader, SPACE( 15 ) + ; + PADC( TRIM( XMEMOLINE( LTRIM( aTempPgHeader[ nLine ]),; + nHeadingLength,nHeadLine)), nHeadingLength)) - NEXT nHeadLine + NEXT nHeadLine NEXT nLine aPageHeader[ 1 ] := STUFF(aPageHeader[ 1 ], 1, 14, ; NationMsg(_RFRM_PAGENO)+STR(::nPageNumber,6)) @@ -381,11 +385,11 @@ METHOD ReportHeader() CLASS TReportForm AADD( aPageHeader, SPACE((nRPageSize - ::aReportData[ RPT_LMARGIN ] -; LEN( cHeader ) ) / 2 ) + cHeader ) - NEXT nHeadLine - + NEXT nHeadLine + NEXT nLine - nLineInHeader := LEN( aPageHeader) + nLinesInHeader := LEN( aPageHeader) nMaxColLength :=0 FOR nCol := 1 TO LEN( ::aReportData[RPT_COLUMNS] ) nMaxColLength := MAX(LEN(::aReportData[RPT_COLUMNS,nCol,RCT_HEADER]), ; @@ -429,11 +433,12 @@ METHOD ReportHeader() CLASS TReportForm // Set the page number and number of available lines ::nPageNumber++ - // adjust the line count to account for Summer '87 behavior + // adjust the line count to account for Summer '87 behavior ::nLinesLeft := ::aReportData[RPT_LINES] - LEN( aPageHeader ) ::nMaxLinesAvail := ::aReportData[RPT_LINES] - LEN( aPageHeader ) RETURN SELF + METHOD ExecuteReport() CLASS TReportForm LOCAL aRecordHeader := {} // Header for the current record @@ -466,29 +471,29 @@ METHOD ExecuteReport() CLASS TReportForm FOR nGroup := LEN(::aReportData[RPT_GROUPS]) TO 1 STEP -1 - // make sure group has subtotals - lAnySubTotals := .F. - FOR nCol := 1 TO LEN(::aReportData[RPT_COLUMNS]) - IF ::aReportData[RPT_COLUMNS,nCol,RCT_TOTAL] - lAnySubTotals := .T. - EXIT // NOTE + // make sure group has subtotals + lAnySubTotals := .F. + FOR nCol := 1 TO LEN(::aReportData[RPT_COLUMNS]) + IF ::aReportData[RPT_COLUMNS,nCol,RCT_TOTAL] + lAnySubTotals := .T. + EXIT // NOTE + ENDIF + NEXT + + // retrieve group eject state from report form + IF ( nGroup == 1 ) + lEjectGrp := ::aReportData[ RPT_GROUPS, nGroup, RGT_AEJECT ] ENDIF - NEXT - // retrieve group eject state from report form - IF ( nGroup == 1 ) - lEjectGrp := ::aReportData[ RPT_GROUPS, nGroup, RGT_AEJECT ] - ENDIF - - IF !lAnySubTotals - LOOP // NOTE - ENDIF + IF !lAnySubTotals + LOOP // NOTE + ENDIF // For subgroup processing: check if group has been changed - IF MakeAStr(EVAL(::aReportData[RPT_GROUPS, 1, RGT_EXP]),; - ::aReportData[RPT_GROUPS, 1, RGT_TYPE]) != ::aGroupTotals[1] - lGroupChanged := .T. - ENDIF + IF MakeAStr(EVAL(::aReportData[RPT_GROUPS, 1, RGT_EXP]),; + ::aReportData[RPT_GROUPS, 1, RGT_TYPE]) != ::aGroupTotals[1] + lGroupChanged := .T. + ENDIF // If this (sub)group has changed since the last record IF lGroupChanged .OR. MakeAStr(EVAL(::aReportData[RPT_GROUPS,nGroup,RGT_EXP]),; @@ -525,34 +530,34 @@ METHOD ExecuteReport() CLASS TReportForm ENDIF - IF ( LEN( aRecordHeader ) > 0 ) .AND. lEjectGrp .AND. lGroupChanged + IF ( LEN( aRecordHeader ) > 0 ) .AND. lEjectGrp .AND. lGroupChanged IF LEN( aRecordHeader ) > ::nLinesLeft ::EjectPage() IF ( ::aReportData[ RPT_PLAIN ] ) ::nLinesLeft := 1000 - ELSE + ELSE ::ReportHeader() - ENDIF + ENDIF - ENDIF + ENDIF - AEVAL( aRecordHeader, { | HeaderLine | ; - ::PrintIt( SPACE( ::aReportData[ RPT_LMARGIN ] ) + HeaderLine ) } ) + AEVAL( aRecordHeader, { | HeaderLine | ; + ::PrintIt( SPACE( ::aReportData[ RPT_LMARGIN ] ) + HeaderLine ) } ) - aRecordHeader := {} + aRecordHeader := {} ::EjectPage() IF ( ::aReportData[ RPT_PLAIN ] ) ::nLinesLeft := 1000 - ELSE + ELSE ::ReportHeader() - ENDIF + ENDIF - ENDIF + ENDIF // Add to aRecordHeader in the event that the group has changed and // new group headers need to be generated @@ -565,7 +570,7 @@ METHOD ExecuteReport() CLASS TReportForm ELSE AADD( aRecordHeader, "" ) // The blank line -// page eject after group + // page eject after group // put CRFF after group IF nGroup == 1 .AND. !::lFirstPass .AND. !lAnySubTotals @@ -635,9 +640,9 @@ METHOD ExecuteReport() CLASS TReportForm // Only run through the record detail if this is NOT a summary report IF !::aReportData[ RPT_SUMMARY ] // Determine the max number of lines needed by each expression - nMaxLines := 1 + nMaxLines := 1 FOR nCol := 1 TO LEN(::aReportData[RPT_COLUMNS]) - + IF ::aReportData[RPT_COLUMNS,nCol,RCT_TYPE] $ "M" nMaxLines := MAX(XMLCOUNT(EVAL(::aReportData[RPT_COLUMNS,nCol,RCT_EXP]),; ::aReportData[RPT_COLUMNS,nCol,RCT_WIDTH]), nMaxLines) @@ -667,7 +672,7 @@ METHOD ExecuteReport() CLASS TReportForm ELSE cLine := XMEMOLINE(TRIM(EVAL(::aReportData[RPT_COLUMNS,nCol,RCT_EXP])),; ::aReportData[RPT_COLUMNS,nCol,RCT_WIDTH], nLine ) - ENDIF + ENDIF cLine := PADR( cLine, ::aReportData[RPT_COLUMNS,nCol,RCT_WIDTH] ) ELSE IF nLine == 1 @@ -734,7 +739,7 @@ METHOD ExecuteReport() CLASS TReportForm // Tack on the spacing for double/triple/etc. IF ::aReportData[ RPT_SPACING ] > 1 -/* Double space problem in REPORT FORM at the bottom of the page */ + /* Double space problem in REPORT FORM at the bottom of the page */ IF ::nLinesLeft >= ::aReportData[ RPT_SPACING ] - 1 FOR nLine := 2 TO ::aReportData[ RPT_SPACING ] @@ -746,8 +751,7 @@ METHOD ExecuteReport() CLASS TReportForm ENDIF // Was this a summary report? - RETURN - + RETURN NIL METHOD LoadReportFile(cFrmFile) CLASS TReportForm LOCAL cFieldsBuff @@ -758,7 +762,7 @@ METHOD LoadReportFile(cFrmFile) CLASS TReportForm LOCAL cSubGroupExp := SPACE(200) LOCAL nColCount := 0 // Number of columns in report LOCAL nCount - LOCAL nFrmHandle // (.FRM) file handle + LOCAL nFrmHandle // (.frm) file handle LOCAL nBytesRead // Read/write and content record counter LOCAL nPointer := 0 // Points to an offset into EXPR_BUFF string LOCAL nFileError // Contains current file error @@ -773,8 +777,8 @@ METHOD LoadReportFile(cFrmFile) CLASS TReportForm LOCAL s, paths LOCAL i - LOCAL aHeader // temporary storage for report form headings - LOCAL nHeaderIndex // index into temporary header array + LOCAL aHeader // temporary storage for report form headings + LOCAL nHeaderIndex // index into temporary header array // Initialize STATIC buffer values ::cLengthsBuff := "" @@ -830,34 +834,34 @@ METHOD LoadReportFile(cFrmFile) CLASS TReportForm ENDIF // OPEN ok? - IF nFileError = F_OK + IF nFileError == F_OK // Go to START of report file FSEEK(nFrmHandle, 0) // SEEK ok? - nFileError = FERROR() - IF nFileError = F_OK + nFileError := FERROR() + IF nFileError == F_OK // Read entire file into process buffer - nBytesRead = FREAD(nFrmHandle, @cFileBuff, SIZE_FILE_BUFF) + nBytesRead := FREAD(nFrmHandle, @cFileBuff, SIZE_FILE_BUFF) // READ ok? - IF nBytesRead = 0 - nFileError = F_EMPTY // file is empty + IF nBytesRead == 0 + nFileError := F_EMPTY // file is empty ELSE - nFileError = FERROR() // check for DOS errors + nFileError := FERROR() // check for DOS errors ENDIF - IF nFileError = F_OK + IF nFileError == F_OK // Is this a .FRM type file (2 at start and end of file) - IF BIN2W(SUBSTR(cFileBuff, 1, 2)) = 2 .AND.; - BIN2W(SUBSTR(cFileBuff, SIZE_FILE_BUFF - 1, 2)) = 2 + IF BIN2W(SUBSTR(cFileBuff, 1, 2)) == 2 .AND.; + BIN2W(SUBSTR(cFileBuff, SIZE_FILE_BUFF - 1, 2)) == 2 - nFileError = F_OK + nFileError := F_OK ELSE - nFileError = F_ERROR + nFileError := F_ERROR ENDIF ENDIF @@ -866,146 +870,161 @@ METHOD LoadReportFile(cFrmFile) CLASS TReportForm // Close file IF !FCLOSE(nFrmHandle) - nFileError = FERROR() + nFileError := FERROR() ENDIF ENDIF -// File existed, was opened and read ok and is a .FRM file -IF nFileError = F_OK + // File existed, was opened and read ok and is a .FRM file + IF nFileError == F_OK - // Fill processing buffers - ::cLengthsBuff = SUBSTR(cFileBuff, LENGTHS_OFFSET, SIZE_LENGTHS_BUFF) - ::cOffSetsBuff = SUBSTR(cFileBuff, OFFSETS_OFFSET, SIZE_OFFSETS_BUFF) - ::cExprBuff = SUBSTR(cFileBuff, EXPR_OFFSET, SIZE_EXPR_BUFF) - cFieldsBuff = SUBSTR(cFileBuff, FIELDS_OFFSET, SIZE_FIELDS_BUFF) - cParamsBuff = SUBSTR(cFileBuff, PARAMS_OFFSET, SIZE_PARAMS_BUFF) + // Fill processing buffers + ::cLengthsBuff := SUBSTR(cFileBuff, LENGTHS_OFFSET, SIZE_LENGTHS_BUFF) + ::cOffSetsBuff := SUBSTR(cFileBuff, OFFSETS_OFFSET, SIZE_OFFSETS_BUFF) + ::cExprBuff := SUBSTR(cFileBuff, EXPR_OFFSET, SIZE_EXPR_BUFF) + cFieldsBuff := SUBSTR(cFileBuff, FIELDS_OFFSET, SIZE_FIELDS_BUFF) + cParamsBuff := SUBSTR(cFileBuff, PARAMS_OFFSET, SIZE_PARAMS_BUFF) - // Process report attributes - // Report width - aReport[ RPT_WIDTH ] := BIN2W(SUBSTR(cParamsBuff, PAGE_WIDTH_OFFSET, 2)) + // Process report attributes + // Report width + aReport[ RPT_WIDTH ] := BIN2W(SUBSTR(cParamsBuff, PAGE_WIDTH_OFFSET, 2)) - // Lines per page - aReport[ RPT_LINES ] := BIN2W(SUBSTR(cParamsBuff, LNS_PER_PAGE_OFFSET, 2)) + // Lines per page + aReport[ RPT_LINES ] := BIN2W(SUBSTR(cParamsBuff, LNS_PER_PAGE_OFFSET, 2)) - // Page offset (left margin) - aReport[ RPT_LMARGIN ] := BIN2W(SUBSTR(cParamsBuff, LEFT_MRGN_OFFSET, 2)) + // Page offset (left margin) + aReport[ RPT_LMARGIN ] := BIN2W(SUBSTR(cParamsBuff, LEFT_MRGN_OFFSET, 2)) - // Page right margin (not used) - aReport[ RPT_RMARGIN ] := BIN2W(SUBSTR(cParamsBuff, RIGHT_MGRN_OFFSET, 2)) + // Page right margin (not used) + aReport[ RPT_RMARGIN ] := BIN2W(SUBSTR(cParamsBuff, RIGHT_MGRN_OFFSET, 2)) - nColCount = BIN2W(SUBSTR(cParamsBuff, COL_COUNT_OFFSET, 2)) + nColCount := BIN2W(SUBSTR(cParamsBuff, COL_COUNT_OFFSET, 2)) - // Line spacing - // Spacing is 1, 2, or 3 - aReport[ RPT_SPACING ] := IF(SUBSTR(cParamsBuff, ; - DBL_SPACE_OFFSET, 1) $ "YyTt", 2, 1) + // Line spacing + // Spacing is 1, 2, or 3 + aReport[ RPT_SPACING ] := IF(SUBSTR(cParamsBuff, ; + DBL_SPACE_OFFSET, 1) $ "YyTt", 2, 1) - // Summary report flag - aReport[ RPT_SUMMARY ] := IF(SUBSTR(cParamsBuff, ; - SUMMARY_RPT_OFFSET, 1) $ "YyTt", .T., .F.) + // Summary report flag + aReport[ RPT_SUMMARY ] := IF(SUBSTR(cParamsBuff, ; + SUMMARY_RPT_OFFSET, 1) $ "YyTt", .T., .F.) - // Process report eject and plain attributes option byte - cOptionByte = ASC(SUBSTR(cParamsBuff, OPTION_OFFSET, 1)) + // Process report eject and plain attributes option byte + cOptionByte := ASC(SUBSTR(cParamsBuff, OPTION_OFFSET, 1)) - IF INT(cOptionByte / 4) = 1 - aReport[ RPT_PLAIN ] := .T. // Plain page - cOptionByte -= 4 - ENDIF - - IF INT(cOptionByte / 2) = 1 - aReport[ RPT_AEJECT ] := .T. // Page eject after report - cOptionByte -= 2 - ENDIF - - IF INT(cOptionByte / 1) = 1 - aReport[ RPT_BEJECT ] := .F. // Page eject before report - cOptionByte -= 1 - ENDIF - - // Page heading, report title - nPointer = BIN2W(SUBSTR(cParamsBuff, PAGE_HDR_OFFSET, 2)) - - // Retrieve the header stored in the .FRM file - nHeaderIndex := 4 - aHeader := ParseHeader( ::GetExpr( nPointer ), nHeaderIndex ) - - // certain that we have retrieved all heading entries from the .FRM file, we - // now retract the empty headings - DO WHILE ( nHeaderIndex > 0 ) - IF ! EMPTY( aHeader[ nHeaderIndex ] ) - EXIT - ENDIF - nHeaderIndex-- - ENDDO - - aReport[ RPT_HEADER ] := IIF( EMPTY( nHeaderIndex ) , {}, ; - ASIZE( aHeader, nHeaderIndex ) ) - - // Process Groups - // Group - nPointer = BIN2W(SUBSTR(cParamsBuff, GRP_EXPR_OFFSET, 2)) - - IF !EMPTY(cGroupExp := ::GetExpr( nPointer )) - - // Add a new group array - AADD( aReport[ RPT_GROUPS ], ARRAY( RG_COUNT )) - - // Group expression - aReport[ RPT_GROUPS ][1][ RG_TEXT ] := cGroupExp - aReport[ RPT_GROUPS ][1][ RG_EXP ] := &( "{ || " + cGroupExp + "}" ) - IF USED() - aReport[ RPT_GROUPS ][1][ RG_TYPE ] := ; - VALTYPE( EVAL( aReport[ RPT_GROUPS ][1][ RG_EXP ] ) ) + IF INT(cOptionByte / 4) == 1 + aReport[ RPT_PLAIN ] := .T. // Plain page + cOptionByte -= 4 ENDIF - // Group header - nPointer = BIN2W(SUBSTR(cParamsBuff, GRP_HDR_OFFSET, 2)) - aReport[ RPT_GROUPS ][1][ RG_HEADER ] := ::GetExpr( nPointer ) - - // Page eject after group - aReport[ RPT_GROUPS ][1][ RG_AEJECT ] := IF(SUBSTR(cParamsBuff, ; - PE_OFFSET, 1) $ "YyTt", .T., .F.) - - ENDIF - - // Subgroup - nPointer = BIN2W(SUBSTR(cParamsBuff, SUB_EXPR_OFFSET, 2)) - - IF !EMPTY(cSubGroupExp := ::GetExpr( nPointer )) - - // Add new group array - AADD( aReport[ RPT_GROUPS ], ARRAY( RG_COUNT )) - - // Subgroup expression - aReport[ RPT_GROUPS ][2][ RG_TEXT ] := cSubGroupExp - aReport[ RPT_GROUPS ][2][ RG_EXP ] := &( "{ || " + cSubGroupExp + "}" ) - IF USED() - aReport[ RPT_GROUPS ][2][ RG_TYPE ] := ; - VALTYPE( EVAL( aReport[ RPT_GROUPS ][2][ RG_EXP ] ) ) + IF INT(cOptionByte / 2) == 1 + aReport[ RPT_AEJECT ] := .T. // Page eject after report + cOptionByte -= 2 ENDIF - // Subgroup header - nPointer = BIN2W(SUBSTR(cParamsBuff, SUB_HDR_OFFSET, 2)) - aReport[ RPT_GROUPS ][2][ RG_HEADER ] := ::GetExpr( nPointer ) + IF INT(cOptionByte / 1) == 1 + aReport[ RPT_BEJECT ] := .F. // Page eject before report + cOptionByte -= 1 + ENDIF - // Page eject after subgroup - aReport[ RPT_GROUPS ][2][ RG_AEJECT ] := .F. + // Page heading, report title + nPointer := BIN2W(SUBSTR(cParamsBuff, PAGE_HDR_OFFSET, 2)) + + // Retrieve the header stored in the .FRM file + nHeaderIndex := 4 + aHeader := ParseHeader( ::GetExpr( nPointer ), nHeaderIndex ) + + // certain that we have retrieved all heading entries from the .FRM file, we + // now retract the empty headings + DO WHILE ( nHeaderIndex > 0 ) + IF ! EMPTY( aHeader[ nHeaderIndex ] ) + EXIT + ENDIF + nHeaderIndex-- + ENDDO + + aReport[ RPT_HEADER ] := IIF( EMPTY( nHeaderIndex ) , {}, ; + ASIZE( aHeader, nHeaderIndex ) ) + + // Process Groups + // Group + nPointer := BIN2W(SUBSTR(cParamsBuff, GRP_EXPR_OFFSET, 2)) + + IF !EMPTY(cGroupExp := ::GetExpr( nPointer )) + + // Add a new group array + AADD( aReport[ RPT_GROUPS ], ARRAY( RGT_COUNT )) + + // Group expression + aReport[ RPT_GROUPS ][1][ RGT_TEXT ] := cGroupExp + aReport[ RPT_GROUPS ][1][ RGT_EXP ] := &( "{ || " + cGroupExp + "}" ) + IF USED() + aReport[ RPT_GROUPS ][1][ RGT_TYPE ] := ; + VALTYPE( EVAL( aReport[ RPT_GROUPS ][1][ RGT_EXP ] ) ) + ENDIF + + // Group header + nPointer := BIN2W(SUBSTR(cParamsBuff, GRP_HDR_OFFSET, 2)) + aReport[ RPT_GROUPS ][1][ RGT_HEADER ] := ::GetExpr( nPointer ) + + // Page eject after group + aReport[ RPT_GROUPS ][1][ RGT_AEJECT ] := IF(SUBSTR(cParamsBuff, ; + PE_OFFSET, 1) $ "YyTt", .T., .F.) + + ENDIF + + // Subgroup + nPointer := BIN2W(SUBSTR(cParamsBuff, SUB_EXPR_OFFSET, 2)) + + IF !EMPTY(cSubGroupExp := ::GetExpr( nPointer )) + + // Add new group array + AADD( aReport[ RPT_GROUPS ], ARRAY( RGT_COUNT )) + + // Subgroup expression + aReport[ RPT_GROUPS ][2][ RGT_TEXT ] := cSubGroupExp + aReport[ RPT_GROUPS ][2][ RGT_EXP ] := &( "{ || " + cSubGroupExp + "}" ) + IF USED() + aReport[ RPT_GROUPS ][2][ RGT_TYPE ] := ; + VALTYPE( EVAL( aReport[ RPT_GROUPS ][2][ RGT_EXP ] ) ) + ENDIF + + // Subgroup header + nPointer := BIN2W(SUBSTR(cParamsBuff, SUB_HDR_OFFSET, 2)) + aReport[ RPT_GROUPS ][2][ RGT_HEADER ] := ::GetExpr( nPointer ) + + // Page eject after subgroup + aReport[ RPT_GROUPS ][2][ RGT_AEJECT ] := .F. + + ENDIF + + // Process columns + nFieldOffset := 12 // dBASE skips first 12 byte fields block. + FOR nCount := 1 to nColCount + + AADD( aReport[ RPT_COLUMNS ], ::GetColumn( cFieldsBuff, @nFieldOffset ) ) + + NEXT nCount ENDIF - // Process columns - nFieldOffset := 12 // dBASE skips first 12 byte fields block. - FOR nCount := 1 to nColCount + RETURN aReport - AADD( aReport[ RPT_COLUMNS ], ::GetColumn( cFieldsBuff, @nFieldOffset ) ) - - NEXT nCount - -ENDIF - -RETURN aReport +/*** +* GetExpr( nPointer ) --> cString +* +* Reads an expression from EXPR_BUFF via the OFFSETS_BUFF and returns +* a pointer to offset contained in OFFSETS_BUFF that in turn points +* to an expression located in the EXPR_BUFF string. +* +* Notes: +* +* 1. The expression is empty if: +* a. Passed pointer is equal to 65535 +* b. Character following character pointed to by pointer is CHR(0) +* +*/ METHOD GetExpr( nPointer ) CLASS TReportForm LOCAL nExprOffset := 0 @@ -1021,11 +1040,11 @@ METHOD GetExpr( nPointer ) CLASS TReportForm // Calculate offset into OFFSETS_BUFF IF nPointer > 1 - nOffsetOffset = (nPointer * 2) - 1 + nOffsetOffset := (nPointer * 2) - 1 ENDIF - nExprOffset = BIN2W(SUBSTR(::cOffsetsBuff, nOffsetOffset, 2)) - nExprLength = BIN2W(SUBSTR(::cLengthsBuff, nOffsetOffset, 2)) + nExprOffset := BIN2W(SUBSTR(::cOffsetsBuff, nOffsetOffset, 2)) + nExprLength := BIN2W(SUBSTR(::cLengthsBuff, nOffsetOffset, 2)) // EXPR_OFFSET points to a NULL, so add one (+1) to get the string // and subtract one (-1) from EXPR_LENGTH for correct length @@ -1034,20 +1053,20 @@ METHOD GetExpr( nPointer ) CLASS TReportForm nExprLength-- // Extract string - cString = SUBSTR(::cExprBuff, nExprOffset, nExprLength) + cString := SUBSTR(::cExprBuff, nExprOffset, nExprLength) // dBASE does this so we must do it too // Character following character pointed to by pointer is NULL - IF CHR(0) == SUBSTR(cString, 1, 1) .AND. LEN(SUBSTR(cString,1,1)) = 1 - cString = "" + IF CHR(0) == SUBSTR(cString, 1, 1) .AND. LEN(SUBSTR(cString,1,1)) == 1 + cString := "" ENDIF ENDIF - RETURN (cString) - + RETURN cString STATIC FUNCTION Occurs( cSearch, cTarget ) LOCAL nPos, nCount := 0 + DO WHILE !EMPTY( cTarget ) IF (nPos := AT( cSearch, cTarget )) != 0 nCount++ @@ -1057,10 +1076,9 @@ STATIC FUNCTION Occurs( cSearch, cTarget ) cTarget := "" ENDIF ENDDO + RETURN nCount - - STATIC FUNCTION XMLCOUNT( cString, nLineLength, nTabSize, lWrap ) // Set defaults if none specified nLineLength := IF( nLineLength == NIL, 79, nLineLength ) @@ -1070,8 +1088,7 @@ STATIC FUNCTION XMLCOUNT( cString, nLineLength, nTabSize, lWrap ) IF nTabSize >= nLineLength nTabSize := nLineLength - 1 ENDIF - RETURN( MLCOUNT( TRIM(cString), nLineLength, nTabSize, lWrap ) ) - + RETURN MLCOUNT( TRIM(cString), nLineLength, nTabSize, lWrap ) /*** * @@ -1094,56 +1111,40 @@ STATIC FUNCTION XMEMOLINE( cString, nLineLength, nLineNumber, nTabSize, lWrap ) RETURN( MEMOLINE( cString, nLineLength, nLineNumber, nTabSize, lWrap ) ) STATIC FUNCTION ParseHeader( cHeaderString, nFields ) - LOCAL cItem - LOCAL nItemCount := 0 - LOCAL aPageHeader := {} + LOCAL cItem + LOCAL nItemCount := 0 + LOCAL aPageHeader := {} LOCAL nHeaderLen := 254 - LOCAL nPos + LOCAL nPos - DO WHILE ( ++nItemCount <= nFields ) + DO WHILE ( ++nItemCount <= nFields ) - cItem := SUBSTR( cHeaderString, 1, nHeaderLen ) + cItem := SUBSTR( cHeaderString, 1, nHeaderLen ) - // check for explicit delimiter - nPos := AT( ";", cItem ) + // check for explicit delimiter + nPos := AT( ";", cItem ) - IF ! EMPTY( nPos ) - // delimiter present - AADD( aPageHeader, SUBSTR( cItem, 1, nPos - 1 ) ) - ELSE - IF EMPTY( cItem ) - // empty string for S87 and 5.0 compatibility - AADD( aPageHeader, "" ) - ELSE - // exception - AADD( aPageHeader, cItem ) + IF ! EMPTY( nPos ) + // delimiter present + AADD( aPageHeader, SUBSTR( cItem, 1, nPos - 1 ) ) + ELSE + IF EMPTY( cItem ) + // empty string for S87 and 5.0 compatibility + AADD( aPageHeader, "" ) + ELSE + // exception + AADD( aPageHeader, cItem ) - ENDIF - // empty or not, we jump past the field - nPos := nHeaderLen - ENDIF + ENDIF + // empty or not, we jump past the field + nPos := nHeaderLen + ENDIF - cHeaderString := SUBSTR( cHeaderString, nPos + 1 ) + cHeaderString := SUBSTR( cHeaderString, nPos + 1 ) - ENDDO - - RETURN( aPageHeader ) - -/*** -* GetExpr( nPointer ) --> cString -* -* Reads an expression from EXPR_BUFF via the OFFSETS_BUFF and returns -* a pointer to offset contained in OFFSETS_BUFF that in turn points -* to an expression located in the EXPR_BUFF string. -* -* Notes: -* -* 1. The expression is empty if: -* a. Passed pointer is equal to 65535 -* b. Character following character pointed to by pointer is CHR(0) -* -*/ + ENDDO + RETURN aPageHeader /*** * GetColumn( , @ ) --> aColumn @@ -1162,7 +1163,7 @@ METHOD GetColumn( cFieldsBuffer, nOffset ) CLASS TReportForm // Column width aColumn[ RCT_WIDTH ] := BIN2W(SUBSTR(cFieldsBuffer, nOffset + ; - FIELD_WIDTH_OFFSET, 2)) + FIELD_WIDTH_OFFSET, 2)) // Total column? aColumn[ RCT_TOTAL ] := IF(SUBSTR(cFieldsBuffer, nOffset + ; @@ -1170,20 +1171,20 @@ METHOD GetColumn( cFieldsBuffer, nOffset ) CLASS TReportForm // Decimals width aColumn[ RCT_DECIMALS ] := BIN2W(SUBSTR(cFieldsBuffer, nOffset + ; - FIELD_DECIMALS_OFFSET, 2)) + FIELD_DECIMALS_OFFSET, 2)) // Offset (relative to FIELDS_OFFSET), 'point' to // expression area via array OFFSETS[] // Content expression - nPointer = BIN2W(SUBSTR(cFieldsBuffer, nOffset +; + nPointer := BIN2W(SUBSTR(cFieldsBuffer, nOffset +; FIELD_CONTENT_EXPR_OFFSET, 2)) aColumn[ RCT_TEXT ] := ::GetExpr( nPointer ) cExpr := aColumn[ RCT_TEXT ] aColumn[ RCT_EXP ] := &( "{ || " + cExpr + "}" ) // Header expression - nPointer = BIN2W(SUBSTR(cFieldsBuffer, nOffset +; + nPointer := BIN2W(SUBSTR(cFieldsBuffer, nOffset +; FIELD_HEADER_EXPR_OFFSET, 2)) aColumn[ RCT_HEADER ] := ListAsArray(::GetExpr( nPointer ), ";") @@ -1194,18 +1195,18 @@ METHOD GetColumn( cFieldsBuffer, nOffset ) CLASS TReportForm cType := VALTYPE( EVAL(aColumn[ RCT_EXP ]) ) aColumn[ RCT_TYPE ] := cType DO CASE - CASE cType = "C" .OR. cType = "M" + CASE cType == "C" .OR. cType == "M" aColumn[ RCT_PICT ] := REPLICATE("X", aColumn[ RCT_WIDTH ]) - CASE cType = "D" + CASE cType == "D" aColumn[ RCT_PICT ] := "@D" - CASE cType = "N" + CASE cType == "N" IF aColumn[ RCT_DECIMALS ] != 0 aColumn[ RCT_PICT ] := REPLICATE("9", aColumn[ RCT_WIDTH ] - aColumn[ RCT_DECIMALS ] -1) + "." + ; REPLICATE("9", aColumn[ RCT_DECIMALS ]) ELSE aColumn[ RCT_PICT ] := REPLICATE("9", aColumn[ RCT_WIDTH ]) ENDIF - CASE cType = "L" + CASE cType == "L" aColumn[ RCT_PICT ] := "@L" + REPLICATE("X",aColumn[ RCT_WIDTH ]-1) ENDCASE ENDIF @@ -1213,7 +1214,7 @@ METHOD GetColumn( cFieldsBuffer, nOffset ) CLASS TReportForm // Update offset into ?_buffer nOffset += 12 - RETURN ( aColumn ) + RETURN aColumn /*** * @@ -1231,15 +1232,15 @@ STATIC FUNCTION ListAsArray( cList, cDelimiter ) cDelimiter := "," ENDIF - DO WHILE ( LEN(cList) <> 0 ) + DO WHILE LEN(cList) <> 0 nPos := AT(cDelimiter, cList) - IF ( nPos == 0 ) + IF nPos == 0 nPos := LEN(cList) ENDIF - IF ( SUBSTR( cList, nPos, 1 ) == cDelimiter ) + IF SUBSTR( cList, nPos, 1 ) == cDelimiter lDelimLast := .T. AADD(aList, SUBSTR(cList, 1, nPos - 1)) // Add a new element ELSE @@ -1251,7 +1252,7 @@ STATIC FUNCTION ListAsArray( cList, cDelimiter ) ENDDO - IF ( lDelimLast ) + IF lDelimLast AADD(aList, "") ENDIF @@ -1275,10 +1276,11 @@ STATIC FUNCTION MakeAStr( uVar, cType ) OTHERWISE cString := "INVALID EXPRESSION" ENDCASE - RETURN( cString ) + RETURN cString FUNCTION __ReportForm( cFRMName, lPrinter, cAltFile, lNoConsole, bFor, ; bWhile, nNext, nRecord, lRest, lPlain, cHeading, ; lBEject, lSummary ) -Return ( TReportForm():New(cFrmName,lPrinter,cAltFile,lNoConsole,bFor,bWhile,nNext,nRecord,; - lRest,lPlain,cHeading,lBEject,lSummary) ) + RETURN TReportForm():New(cFrmName,lPrinter,cAltFile,lNoConsole,bFor,bWhile,nNext,nRecord,; + lRest,lPlain,cHeading,lBEject,lSummary) + diff --git a/harbour/tests/testlbl.prg b/harbour/tests/testlbl.prg index 1dfe2e422c..1527bffe13 100644 --- a/harbour/tests/testlbl.prg +++ b/harbour/tests/testlbl.prg @@ -1,3 +1,6 @@ +/* + * $Id$ + */ FUNCTION MAIN() diff --git a/harbour/tests/testrpt.prg b/harbour/tests/testrpt.prg index e1e56363aa..f8d252ee2d 100644 --- a/harbour/tests/testrpt.prg +++ b/harbour/tests/testrpt.prg @@ -1,3 +1,7 @@ +/* + * $Id$ + */ + FUNCTION() MAIN USE Test New