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;
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;
PROCEDURE CloseReport( (* Close Report & spool output *)
(*-----------Parameters-----------*)
VAR r: Report; (* Report ADT *)
VAR result: CARDINAL (* Result returned from procedure *)
);
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;
