IMPLEMENTATION MODULE Reports; (*$VER 0.9(103)*) (* ---------------------------------------------------------------------- Copyright 1988 (c) by Highlander Software Group. All Rights Reserved Title: Report Library Module Implementation Module Purpose: This library module defines the Report ADT, or object, and a set of procedures for manipulating reports. All of the functions required for creating, formating and disposing of report objects are provided. History: 0.9 100 10/01/88 MTM Original version. 101 11/02/88 MTM Expanded Hdr, Lgn & Tlr text to 255 bytes. 102 11/03/88 MTM Correct column header overflow by deleteing Len(header) characters. 103 11/09/88 MTM Correct error in length of maskstring for String fields in FormatLine. 104 11/15/88 MTM Added logic for newline and nobreakbar. ---------------------------------------------------------------------- *) (*--- LIBRARY IMPORT DEFINITIONS ---*) FROM SYSTEM IMPORT ADDRESS, (* Address TYPE *) ADR, (* Function to return address of variable *) TSIZE, (* Function to return size of TYPE *) VAL; (* Function to convert value to different TYPE *) FROM Switches IMPORT DirLib, (* Current Data Directory Library Ersatz device *) FdmLib; (* Current File Definition Ersatz device *) FROM Versions IMPORT GetVersionString; (* Procedure to return version number *) (* currently running program. *) FROM Storage IMPORT ALLOCATE, (* Procedure to allocate heap storage *) DEALLOCATE; (* Procedure to deallocate heap storage *) FROM Streams IMPORT Stream, (* Stream Abstract Data Type *) StreamType, (* Enumeration TYPE for type of stream *) StreamMode, (* Enumeration TYPE for processing mode *) ConnectStream, (* Procedure to open stream for processing *) DisconnectStream, (* Procedure to close stream processing *) WriteChar, (* Procedure to write single char to stream *) WriteStr; (* Procedure to write string to stream *) FROM Numbers IMPORT WriteCard; (* Procedure to write cardinal var to terminal *) FROM DateTime IMPORT DATE, (* Date Abstract Data Type *) TIME, (* Time Abstract Data Type *) GetSysDate, (* Procedure to read system date *) GetSysTime, (* Procedure to read system time *) DecodeDate, (* Procedure to convert date to display format *) DecodeTime; (* Procedure to convert time to display format *) FROM FastData IMPORT Fill; (* Procedure to fill memory area with a char *) FROM Conversions IMPORT StringToCard, (* Procedure to convert string val to cardinal *) CardToString, (* Procedure to convert cardinal val to string *) IntToString; (* Procedure to convert integer val to string *) FROM LongConversions IMPORT LongIntToString, (* Procedure to convert LongInt val to string *) LongCardToString; (* Procedure to convert LongCard val to string *) FROM MaskLibrary IMPORT MaskString, (* Procedure to convert val with string mask *) MaskNumber, (* Procedure to convert val with numeric mask *) MaskDollar; (* Procedure to convert val with dollar mask *) FROM Strings IMPORT Compare, (* Procedure to compare two strings *) Assign, (* Procedure to assign one string to another *) Insert, (* Procedure to insert one string in another *) Delete, (* Procedure to delete one string from another *) Length, (* Procedure to calculate length of string *) Copy; (* Procedure to copy part of a string to another*) FROM ASCII IMPORT FF, (* Constant for Form Feed *) EOL; (* Constant for End of Line *) FROM Terminal IMPORT WriteLn, (* Procedure to write end-of line to terminal *) Write, (* Procedure to write single char to terminal *) WriteString, (* Procedure to write string to terminal *) Read; (* Procedure to read single char from terminal *) FROM Spooler IMPORT SpoolFile; (* Procedure to spool file to printer queue *) (*--- TYPE DEFINITIONS ---*) TYPE HdrPtr = POINTER TO HdrRcd; (* Report header linked list node *) HdrRcd = RECORD text: ARRAY [0..255] OF CHAR; next: HdrPtr; END; LgnPtr = POINTER TO LgnRcd; (* Report legend linked list node *) LgnRcd = RECORD text: ARRAY [0..255] OF CHAR; next: LgnPtr; END; TlrPtr = POINTER TO TlrRcd; (* Report trailer linked list node *) TlrRcd = RECORD text: ARRAY [0..255] OF CHAR; next: TlrPtr; END; ColPtr = POINTER TO ColRcd; (* Report column linked list node *) ColRcd = RECORD Start: CARDINAL; Width: CARDINAL; Data: ADDRESS; Type: DataType; Mask: ARRAY [0..35] OF CHAR; Options: BITSET; MaxLen: CARDINAL; ColCnt: ARRAY [0..2] OF LONGCARD; ColTot: ARRAY [0..2] OF LONGINT; ColMax: ARRAY [0..2] OF LONGINT; ColMin: ARRAY [0..2] OF LONGINT; Next: ColPtr; END; BrkPtr = POINTER TO BrkRcd; (* Report break linked list node *) BrkRcd = RECORD text: ARRAY [0..255] OF CHAR; next: BrkPtr; END; Report = POINTER TO RepRcd; (* Report ADT implementation record *) RepRcd = RECORD Output: Stream; Title: ARRAY [0..63] OF CHAR; Printer: ARRAY [0..5] OF CHAR; Name: ARRAY [0..15] OF CHAR; Header: HdrPtr; Trailer: TlrPtr; Legend: LgnPtr; SubBrk: BrkPtr; TotBrk: BrkPtr; GrdBrk: BrkPtr; NumCol: CARDINAL; ColOffset: CARDINAL; ColGap: CARDINAL; FirstCol: ColPtr; LastCol: ColPtr; Options: BITSET; ColHdrT: POINTER TO ARRAY [0..255] OF CHAR; ColHdrD: POINTER TO ARRAY [0..255] OF CHAR; ColData: POINTER TO ARRAY [0..255] OF CHAR; ColSubt: POINTER TO ARRAY [0..255] OF CHAR; ColTotl: POINTER TO ARRAY [0..255] OF CHAR; ColGrnd: POINTER TO ARRAY [0..255] OF CHAR; Copies: CARDINAL; DelRpt: BOOLEAN; Form: ARRAY [0..5] OF CHAR; LineWidth: CARDINAL; LinePerPage:CARDINAL; Page: CARDINAL; Line: CARDINAL; END; (*--- LOCAL VARIABLES ---*) VAR date: DATE; time: TIME; datemask: ARRAY [0..11] OF CHAR; timemask: ARRAY [0..11] OF CHAR; version: ARRAY [0..31] OF CHAR; (*--- INTERNAL PROCEDURE DEFINITIONS ---*) PROCEDURE AllBlank(VAR text: ARRAY OF CHAR):BOOLEAN; VAR i: CARDINAL; BEGIN FOR i := 0 TO VAL(CARDINAL,HIGH(text)) DO IF text[i] # ' ' THEN RETURN FALSE; END; END; RETURN TRUE; END AllBlank; PROCEDURE DefineBreak(r: Report; VAR head: BrkPtr; txt: ARRAY OF CHAR; VAR result: CARDINAL); VAR bptr: BrkPtr; BEGIN IF NOT AllBlank(txt) THEN IF head = NIL THEN ALLOCATE(head,TSIZE(BrkRcd)); head^.next := NIL; Assign(txt,head^.text); ELSE bptr := head; WHILE bptr^.next # NIL DO bptr := bptr^.next; END; ALLOCATE(bptr^.next,TSIZE(BrkRcd)); bptr := bptr^.next; bptr^.next := NIL; Assign(txt,bptr^.text); END; END; END DefineBreak; PROCEDURE ClearBreak(r: Report; VAR head: BrkPtr; VAR result: CARDINAL); VAR bptr,ctlr: BrkPtr; BEGIN IF r # NIL THEN bptr := head; WHILE bptr # NIL DO ctlr := bptr; bptr := bptr^.next; DEALLOCATE(ctlr,TSIZE(BrkRcd)); END; head := NIL; END; END ClearBreak; PROCEDURE SetupSummary(r: Report; lev: CARDINAL; col: CARDINAL; title: ARRAY OF CHAR; VAR result: CARDINAL); VAR cptr: ColPtr; done: BOOLEAN; work: ARRAY [0..15] OF CHAR; temp: ARRAY [0..15] OF CHAR; average: LONGINT; BEGIN IF Total IN r^.Options THEN cptr := r^.FirstCol; Insert(title,r^.ColData^,col); Insert("Totals",r^.ColData^,col+Length(title)+1); WHILE cptr # NIL DO cptr^.ColCnt[lev] := 0D; IF Total IN cptr^.Options THEN LongIntToString(cptr^.ColTot[lev],work,cptr^.Width,done); MaskDollar(ADR(work),ADR(cptr^.Mask),ADR(temp), Length(cptr^.Mask)); Insert(temp,r^.ColData^,cptr^.Start); cptr^.ColTot[lev] := 0D; END; IF NewLine IN cptr^.Options THEN IF Compare(title,"NO PRINT") # 0 THEN r^.ColData^[r^.LineWidth] := 0C; PrintLine(r,r^.ColData^,{},result); END; Fill(r^.ColData,r^.LineWidth,' '); END; cptr := cptr^.Next; END; IF Compare(title,"NO PRINT") # 0 THEN r^.ColData^[r^.LineWidth] := 0C; PrintLine(r,r^.ColData^,{},result); END; Fill(r^.ColData,r^.LineWidth,' '); END; IF Average IN r^.Options THEN cptr := r^.FirstCol; Insert("Average",r^.ColData^,col+1); WHILE cptr # NIL DO IF Average IN cptr^.Options THEN IF cptr^.ColCnt[lev] # 0D THEN average := cptr^.ColTot[lev] DIV VAL(LONGINT,cptr^.ColCnt[lev]); ELSE average := 0D; END; LongIntToString(average,work,cptr^.Width,done); MaskDollar(ADR(work),ADR(cptr^.Mask),ADR(temp), Length(cptr^.Mask)); Insert(temp,r^.ColData^,cptr^.Start); cptr^.ColTot[lev] := 0D; END; IF NewLine IN cptr^.Options THEN IF Compare(title,"NO PRINT") # 0 THEN r^.ColData^[r^.LineWidth] := 0C; PrintLine(r,r^.ColData^,{},result); END; Fill(r^.ColData,r^.LineWidth,' '); END; cptr := cptr^.Next; END; IF Compare(title,"NO PRINT") # 0 THEN r^.ColData^[r^.LineWidth] := 0C; PrintLine(r,r^.ColData^,{},result); END; Fill(r^.ColData,r^.LineWidth,' '); END; cptr := r^.FirstCol; WHILE cptr # NIL DO cptr^.ColCnt[lev] := 0D; cptr := cptr^.Next; END; END SetupSummary; (*--- EXPORTED PROCEDURE DEFINITIONS ---*) PROCEDURE StartNewPage( (* Force start of new page on Rpt *) (*-----------Parameters-----------*) r: Report (* Report ADT *) ); VAR rc,i: CARDINAL; header: ARRAY [0..255] OF CHAR; temp: ARRAY [0..3] OF CHAR; done: BOOLEAN; size: CARDINAL; hptr: HdrPtr; lptr: LgnPtr; tptr: TlrPtr; BEGIN IF (r^.Page = 0) AND (r^.NumCol # 0) THEN DefineHeader(r,r^.ColHdrT^,{},rc); DefineHeader(r,r^.ColHdrD^,{},rc); DefineBreak(r,r^.SubBrk,r^.ColSubt^,rc); DefineBreak(r,r^.TotBrk,r^.ColTotl^,rc); DefineBreak(r,r^.GrdBrk,r^.ColGrnd^,rc); END; INC(r^.Page); r^.Line := 1; WriteChar(r^.Output,FF,rc); Fill(ADR(header),r^.LineWidth,' '); Insert("Report:",header,0); Insert(r^.Title,header,8); Insert("Page:",header,r^.LineWidth-9); CardToString(r^.Page,temp,4,done); Insert(temp,header,r^.LineWidth-4); header[r^.LineWidth] := 0C; WriteStr(r^.Output,header,rc); WriteChar(r^.Output,EOL,rc); INC(r^.Line); Fill(ADR(header),r^.LineWidth,' '); Insert("Run on:",header,0); Insert(datemask,header,8); Insert(" at ",header,17); Insert(timemask,header,21); header[r^.LineWidth] := 0C; WriteStr(r^.Output,header,rc); WriteChar(r^.Output,EOL,rc); INC(r^.Line); Fill(ADR(header),r^.LineWidth,' '); size := Length(version); Insert("By pgm:",header,0); Insert(version,header,8); Insert(" using: DirLib=",header,9+size); Insert(DirLib,header,24+size); Insert(" FdmLib=",header,29+size); Insert(FdmLib,header,37+size); header[r^.LineWidth] := 0C; WriteStr(r^.Output,header,rc); WriteChar(r^.Output,EOL,rc); INC(r^.Line); WriteChar(r^.Output,EOL,rc); INC(r^.Line); IF (r^.Legend # NIL) AND (r^.Page = 1) THEN lptr := r^.Legend; WHILE lptr # NIL DO WriteStr(r^.Output,lptr^.text,rc); WriteChar(r^.Output,EOL,rc); INC(r^.Line); lptr := lptr^.next; END; WriteChar(r^.Output,EOL,rc); INC(r^.Line); END; hptr := r^.Header; WHILE hptr # NIL DO WriteStr(r^.Output,hptr^.text,rc); WriteChar(r^.Output,EOL,rc); INC(r^.Line); hptr := hptr^.next; END; END StartNewPage; PROCEDURE EndCurrentPage( (* Finish current page on Rpt *) (*-----------Parameters-----------*) r: Report (* Report ADT *) ); VAR tptr,ctlr: TlrPtr; i,rc: CARDINAL; done: BOOLEAN; BEGIN IF r # NIL THEN IF r^.Line < r^.LinePerPage-1 THEN FOR i := r^.Line TO r^.LinePerPage-1 DO WriteChar(r^.Output,EOL,rc); END; r^.Line := r^.LinePerPage; END; IF r^.Trailer # NIL THEN tptr := r^.Trailer; WHILE tptr # NIL DO WriteStr(r^.Output,tptr^.text,rc); WriteChar(r^.Output,EOL,rc); tptr := tptr^.next; END; END; r^.Line := 0; END; END EndCurrentPage; PROCEDURE OpenReport( (* Open Report for processing *) (*-----------Parameters-----------*) VAR r: Report; (* Report ADT *) title: ARRAY OF CHAR; (* Title for report *) printer: ARRAY OF CHAR; (* Printer to spool output to *) name: ARRAY OF CHAR; (* Name of disk file for output *) copies: CARDINAL; (* Number of copies of report *) delete: BOOLEAN; (* Delete disk file after spool *) form: ARRAY OF CHAR; (* Form name for report *) linewidth: CARDINAL; (* Width of report line *) lineperpg: CARDINAL; (* Number of lines per page *) colgap: CARDINAL; (* Inter column spacing *) VAR result: CARDINAL (* Result returned from procedure *) ); VAR PtrID: ARRAY [0..5] OF CHAR; PtrTTL: ARRAY [0..31] OF CHAR; Norwid: CARDINAL; Norcode: ARRAY [0..11] OF CHAR; Cmpwid: CARDINAL; Cmpcode: ARRAY [0..11] OF CHAR; Draftcode: ARRAY [0..11] OF CHAR; LQcode: ARRAY [0..11] OF CHAR; BEGIN result := 0; ALLOCATE(r,TSIZE(RepRcd)); ConnectStream(r^.Output,name,TextStream,OutputStream,result); IF result = 0 THEN WITH r^ DO Page := 0; Line := 0; Copies := copies; DelRpt := delete; Assign(form,Form); LineWidth := linewidth; LinePerPage := lineperpg; Header := NIL; Trailer := NIL; Legend := NIL; SubBrk := NIL; TotBrk := NIL; GrdBrk := NIL; Assign(title,Title); Assign(printer,Printer); Assign(name,Name); Options := {}; NumCol := 0; ColOffset := 0; ColGap := colgap; FirstCol := NIL; LastCol := NIL; ALLOCATE(ColHdrT,256); Fill(ColHdrT,256,0C); Fill(ColHdrT,LineWidth,' '); ALLOCATE(ColHdrD,256); Fill(ColHdrD,256,0C); Fill(ColHdrD,LineWidth,' '); ALLOCATE(ColData,256); Fill(ColData,256,0C); Fill(ColData,LineWidth,' '); ALLOCATE(ColSubt,256); Fill(ColSubt,256,0C); Fill(ColSubt,LineWidth,' '); ALLOCATE(ColTotl,256); Fill(ColTotl,256,0C); Fill(ColTotl,LineWidth,' '); ALLOCATE(ColGrnd,256); Fill(ColGrnd,256,0C); Fill(ColGrnd,LineWidth,' '); END; ELSE result := 1; END; END OpenReport; PROCEDURE CloseReport( (* Close Report & spool output *) (*-----------Parameters-----------*) VAR r: Report; (* Report ADT *) VAR result: CARDINAL (* Result returned from procedure *) ); VAR hptr,chdr: HdrPtr; lptr,clgn: LgnPtr; tptr,ctlr: TlrPtr; i,rc: CARDINAL; done: BOOLEAN; flags: BITSET; BEGIN IF r # NIL THEN IF r^.Trailer # NIL THEN IF (r^.Line # 0) THEN IF (r^.Line < r^.LinePerPage-1) THEN FOR i := r^.Line TO r^.LinePerPage-1 DO WriteChar(r^.Output,EOL,rc); END; END; tptr := r^.Trailer; WHILE tptr # NIL DO WriteStr(r^.Output,tptr^.text,rc); WriteChar(r^.Output,EOL,rc); tptr := tptr^.next; END; END; END; hptr := r^.Header; WHILE hptr # NIL DO chdr := hptr; hptr := hptr^.next; DEALLOCATE(chdr,TSIZE(HdrRcd)); END; lptr := r^.Legend; WHILE lptr # NIL DO clgn := lptr; lptr := lptr^.next; DEALLOCATE(clgn,TSIZE(LgnRcd)); END; tptr := r^.Trailer; WHILE tptr # NIL DO ctlr := tptr; tptr := tptr^.next; DEALLOCATE(ctlr,TSIZE(HdrRcd)); END; DisconnectStream(r^.Output,result); flags := {}; IF r^.DelRpt THEN INCL(flags,2); ELSE INCL(flags,3); END; SpoolFile(r^.Name,r^.Printer,r^.Form,r^.Copies,r^.LineWidth, r^.LinePerPage,flags,done); DEALLOCATE(r^.ColHdrT,256); DEALLOCATE(r^.ColHdrD,256); DEALLOCATE(r^.ColData,256); DEALLOCATE(r^.ColSubt,256); DEALLOCATE(r^.ColTotl,256); DEALLOCATE(r^.ColGrnd,256); DEALLOCATE(r,TSIZE(RepRcd)); END; END CloseReport; PROCEDURE PrintLine( (* Include give line into report *) (*-----------Parameters-----------*) r: Report; (* Report ADT *) line: ARRAY OF CHAR; (* Line of output for report *) options: BITSET; (* Display options for line *) VAR result: CARDINAL (* Result returned from procedure *) ); BEGIN IF (r^.Line=0) OR (r^.Line >= r^.LinePerPage) THEN IF (r^.Page > 0) AND (r^.Line # 0) THEN EndCurrentPage(r); END; StartNewPage(r); END; WriteStr(r^.Output,line,result); WriteChar(r^.Output,EOL,result); INC(r^.Line); END PrintLine; PROCEDURE DefineHeader( (* Add line of text to report Hdr *) (*-----------Parameters-----------*) r: Report; (* Report ADT *) txt: ARRAY OF CHAR; (* Text line for header display *) options: BITSET; (* Display options for text *) VAR result: CARDINAL (* Result returned from procedure *) ); VAR hptr: HdrPtr; BEGIN IF NOT AllBlank(txt) THEN IF r^.Header = NIL THEN ALLOCATE(r^.Header,TSIZE(HdrRcd)); r^.Header^.next := NIL; Assign(txt,r^.Header^.text); ELSE hptr := r^.Header; WHILE hptr^.next # NIL DO hptr := hptr^.next; END; ALLOCATE(hptr^.next,TSIZE(HdrRcd)); hptr := hptr^.next; hptr^.next := NIL; Assign(txt,hptr^.text); END; END; END DefineHeader; PROCEDURE ClearHeader( (* Clear all header text for Rpt. *) (*-----------Parameters-----------*) r: Report; (* Report ADT *) VAR result: CARDINAL (* Result returned from procedure *) ); VAR hptr,chdr: HdrPtr; BEGIN IF r # NIL THEN hptr := r^.Header; WHILE hptr # NIL DO chdr := hptr; hptr := hptr^.next; DEALLOCATE(chdr,TSIZE(HdrRcd)); END; r^.Header := NIL; END; END ClearHeader; PROCEDURE DefineLegend( (* Add line of text to Rpt Legend *) (*-----------Parameters-----------*) r: Report; (* Report ADT *) txt: ARRAY OF CHAR; (* Text line for legend display *) options: BITSET; (* Display options for text *) VAR result: CARDINAL (* Result returned from procedure *) ); VAR lptr: LgnPtr; BEGIN IF NOT AllBlank(txt) THEN IF r^.Legend = NIL THEN ALLOCATE(r^.Legend,TSIZE(LgnRcd)); r^.Legend^.next := NIL; Assign(txt,r^.Legend^.text); ELSE lptr := r^.Legend; WHILE lptr^.next # NIL DO lptr := lptr^.next; END; ALLOCATE(lptr^.next,TSIZE(LgnRcd)); lptr := lptr^.next; lptr^.next := NIL; Assign(txt,lptr^.text); END; END; END DefineLegend; PROCEDURE ClearLegend( (* Clear all legend text from Rpt *) (*-----------Parameters-----------*) r: Report; (* Report ADT *) VAR result: CARDINAL (* Result returned from procedure *) ); VAR lptr,clgn: LgnPtr; BEGIN IF r # NIL THEN lptr := r^.Legend; WHILE lptr # NIL DO clgn := lptr; lptr := lptr^.next; DEALLOCATE(clgn,TSIZE(LgnRcd)); END; r^.Legend := NIL; END; END ClearLegend; PROCEDURE DefineTrailer( (* Add line of text to Rpr Trailer*) (*-----------Parameters-----------*) r: Report; (* Report ADT *) txt: ARRAY OF CHAR; (* Text line for report tariler *) options: BITSET; (* Display options for text *) VAR result: CARDINAL (* Result returned from procedure *) ); VAR tptr: TlrPtr; BEGIN IF NOT AllBlank(txt) THEN IF r^.Trailer = NIL THEN ALLOCATE(r^.Trailer,TSIZE(TlrRcd)); r^.Trailer^.next := NIL; Assign(txt,r^.Trailer^.text); ELSE tptr := r^.Trailer; WHILE tptr^.next # NIL DO tptr := tptr^.next; END; ALLOCATE(tptr^.next,TSIZE(TlrRcd)); tptr := tptr^.next; tptr^.next := NIL; Assign(txt,tptr^.text); END; END; END DefineTrailer; PROCEDURE ClearTrailer( (* Clear all trailer text from Rpt*) (*-----------Parameters-----------*) r: Report; (* Report ADT *) VAR result: CARDINAL (* Result returned from procedure *) ); VAR tptr,ctlr: TlrPtr; BEGIN IF r # NIL THEN tptr := r^.Trailer; WHILE tptr # NIL DO ctlr := tptr; tptr := tptr^.next; DEALLOCATE(ctlr,TSIZE(HdrRcd)); END; r^.Trailer := NIL; END; END ClearTrailer; PROCEDURE DefineColumn( (* Define column for report *) (*-----------Parameters-----------*) r: Report; (* Report ADT *) addr: ADDRESS; (* Address of column variable *) type: DataType; (* Data type of column variable *) width: CARDINAL; (* Width of column in report *) mask: ARRAY OF CHAR; (* Display mask for column *) header: ARRAY OF CHAR; (* Column header text *) options: BITSET; (* Display/action options *) VAR result: CARDINAL (* Result returned from procedure *) ); VAR break,subbk,totbk,grdbk: CHAR; cptr: ColPtr; rc,i,maxlen: CARDINAL; BEGIN IF r # NIL THEN IF NewLine IN options THEN DefineHeader(r,r^.ColHdrT^,{},rc); Fill(r^.ColHdrT,r^.LineWidth,' '); DefineHeader(r,r^.ColHdrD^,{},rc); Fill(r^.ColHdrD,r^.LineWidth,' '); r^.ColOffset := 0; DefineBreak(r,r^.SubBrk,r^.ColSubt^,result); Fill(r^.ColSubt,r^.LineWidth,' '); DefineBreak(r,r^.TotBrk,r^.ColTotl^,result); Fill(r^.ColTotl,r^.LineWidth,' '); DefineBreak(r,r^.GrdBrk,r^.ColGrnd^,result); Fill(r^.ColGrnd,r^.LineWidth,' '); END; INC(r^.NumCol); ALLOCATE(cptr,TSIZE(ColRcd)); IF r^.NumCol = 1 THEN r^.FirstCol := cptr; ELSE r^.LastCol^.Next := cptr; END; r^.LastCol := cptr; cptr^.Next := NIL; cptr^.Start := r^.ColOffset; cptr^.Width := width; cptr^.Data := addr; cptr^.Type := type; Assign(mask,cptr^.Mask); cptr^.Options := options; r^.Options := r^.Options + options; FOR i := 0 TO 2 DO cptr^.ColCnt[i] := 0D; cptr^.ColTot[i] := 0D; cptr^.ColMax[i] := 0D; cptr^.ColMin[i] := 0D; END; Delete(r^.ColHdrT^,r^.ColOffset,Length(header)); Insert(header,r^.ColHdrT^,r^.ColOffset); r^.ColHdrT^[r^.LineWidth] := 0C; cptr^.MaxLen := width; i := Length(mask); IF i > cptr^.MaxLen THEN cptr^.MaxLen := i; END; i := Length(header); IF i > cptr^.MaxLen THEN cptr^.MaxLen := i; END; IF NoBreakBar IN options THEN break := ' '; subbk := ' '; totbk := ' '; grdbk := ' '; ELSE break := '-'; subbk := '-'; totbk := '='; grdbk := '*'; END; FOR i := 1 TO cptr^.MaxLen DO r^.ColHdrD^[i+r^.ColOffset-1] := break; END; IF Total IN options THEN FOR i := 1 TO cptr^.MaxLen DO r^.ColSubt^[i+r^.ColOffset-1] := subbk; r^.ColTotl^[i+r^.ColOffset-1] := totbk; r^.ColGrnd^[i+r^.ColOffset-1] := grdbk; END; END; INC(r^.ColOffset,cptr^.MaxLen+r^.ColGap); result := 0; ELSE result := 1; END; END DefineColumn; PROCEDURE FormatLine( (* Format report line by columns *) (*-----------Parameters-----------*) r: Report; (* Report ADT *) VAR result: CARDINAL (* Result returned from procedure *) ); VAR i: CARDINAL; cptr: ColPtr; blptr: POINTER TO BOOLEAN; crptr: POINTER TO CARDINAL; inptr: POINTER TO INTEGER; liptr: POINTER TO LONGINT; lcptr: POINTER TO LONGCARD; sptr: POINTER TO ARRAY [0..255] OF CHAR; work: ARRAY [0..63] OF CHAR; temp: ARRAY [0..63] OF CHAR; done: BOOLEAN; mask: ARRAY [0..11] OF CHAR; BEGIN IF r # NIL THEN cptr := r^.FirstCol; WHILE cptr # NIL DO FOR i := 0 TO 2 DO INC(cptr^.ColCnt[i]); END; CASE cptr^.Type OF | Boolean : blptr := cptr^.Data; IF blptr^ THEN temp := "TRUE"; ELSE temp := "FALSE"; END; | Char : sptr := cptr^.Data; temp[0] := sptr^[0]; temp[1] := 0C; | String : sptr := cptr^.Data; Copy(sptr^,0,cptr^.Width,work); MaskString(ADR(work),ADR(cptr^.Mask),ADR(temp), Length(cptr^.Mask)); | Integer : inptr := cptr^.Data; IF (Total IN cptr^.Options) OR (Average IN cptr^.Options) THEN FOR i := 0 TO 2 DO INC(cptr^.ColTot[i],VAL(LONGINT,inptr^)); END; END; IntToString(inptr^,work,cptr^.Width,done); MaskDollar(ADR(work),ADR(cptr^.Mask),ADR(temp), Length(cptr^.Mask)); | LongInt : liptr := cptr^.Data; IF (Total IN cptr^.Options) OR (Average IN cptr^.Options) THEN FOR i := 0 TO 2 DO INC(cptr^.ColTot[i],liptr^); END; END; LongIntToString(liptr^,work,cptr^.Width,done); MaskDollar(ADR(work),ADR(cptr^.Mask),ADR(temp), Length(cptr^.Mask)); | Cardinal : crptr := cptr^.Data; IF (Total IN cptr^.Options) OR (Average IN cptr^.Options) THEN FOR i := 0 TO 2 DO INC(cptr^.ColTot[i],VAL(LONGINT,crptr^)); END; END; CardToString(crptr^,work,cptr^.Width,done); MaskDollar(ADR(work),ADR(cptr^.Mask),ADR(temp), Length(cptr^.Mask)); | LongCard : lcptr := cptr^.Data; IF (Total IN cptr^.Options) OR (Average IN cptr^.Options) THEN FOR i := 0 TO 2 DO INC(cptr^.ColTot[i],VAL(LONGINT,lcptr^)); END; END; LongCardToString(lcptr^,work,cptr^.Width,done); MaskDollar(ADR(work),ADR(cptr^.Mask),ADR(temp), Length(cptr^.Mask)); | Date : sptr := cptr^.Data; Copy(sptr^,0,8,work); Assign("****/**/**",mask); MaskString(ADR(work),ADR(mask),ADR(temp),10); | Time : sptr := cptr^.Data; Copy(sptr^,0,8,work); Assign("**:**:**",mask); MaskString(ADR(work),ADR(mask),ADR(temp),8); ELSE temp := ""; END; Insert(temp,r^.ColData^,cptr^.Start); cptr := cptr^.Next; IF NewLine IN cptr^.Options THEN r^.ColData^[r^.LineWidth] := 0C; PrintLine(r,r^.ColData^,{},result); Fill(r^.ColData,r^.LineWidth,' '); END; END; r^.ColData^[r^.LineWidth] := 0C; PrintLine(r,r^.ColData^,{},result); Fill(r^.ColData,r^.LineWidth,' '); ELSE result := 1; END; END FormatLine; PROCEDURE FormatSubTotals( (* Format subtotal for report *) (*-----------Parameters-----------*) r: Report; (* Report ADT *) title: ARRAY OF CHAR; (* Title for subtotal line *) column: CARDINAL; (* Display column for title *) VAR result: CARDINAL (* Result returned from procedure *) ); VAR bptr: BrkPtr; BEGIN IF r # NIL THEN IF Compare(title,"NO PRINT") # 0 THEN bptr := r^.SubBrk; WHILE bptr # NIL DO PrintLine(r,bptr^.text,{},result); bptr := bptr^.next; END; END; SetupSummary(r,2,column,title,result); IF Compare(title,"NO PRINT") # 0 THEN PrintLine(r," ",{},result); END; ELSE result := 1; END; END FormatSubTotals; PROCEDURE FormatTotals( (* Format total for report *) (*-----------Parameters-----------*) r: Report; (* Report ADT *) title: ARRAY OF CHAR; (* Title for total line *) column: CARDINAL; (* Display column for title *) VAR result: CARDINAL (* Result returned from procedure *) ); VAR bptr: BrkPtr; BEGIN IF r # NIL THEN IF Compare(title,"NO PRINT") # 0 THEN bptr := r^.TotBrk; WHILE bptr # NIL DO PrintLine(r,bptr^.text,{},result); bptr := bptr^.next; END; END; SetupSummary(r,1,column,title,result); IF Compare(title,"NO PRINT") # 0 THEN PrintLine(r," ",{},result); END; ELSE result := 1; END; END FormatTotals; PROCEDURE FormatGrandTotals( (* Format grand totals for report *) (*-----------Parameters-----------*) r: Report; (* Report ADT *) title: ARRAY OF CHAR; (* Title for grand total line *) column: CARDINAL; (* Display column for title *) VAR result: CARDINAL (* Result returned from procedure *) ); VAR bptr: BrkPtr; BEGIN IF r # NIL THEN bptr := r^.GrdBrk; WHILE bptr # NIL DO PrintLine(r,bptr^.text,{},result); bptr := bptr^.next; END; SetupSummary(r,0,column,title,result); bptr := r^.GrdBrk; WHILE bptr # NIL DO PrintLine(r,bptr^.text,{},result); bptr := bptr^.next; END; PrintLine(r," ",{},result); ELSE result := 1; END; END FormatGrandTotals; BEGIN GetVersionString(version); GetSysDate(date); DecodeDate(date,datemask,{}); GetSysTime(time); DecodeTime(time,timemask,{}); END Reports. .