Category : Dbase (Clipper, FoxBase, etc) Languages Source Code
Archive   : AUTOFORC.ZIP
Filename : BOXES.PRG

* Program.....: Boxes.PRG
* Author......: James Chuang
* Date........: March 1, 1988
* Versions....: dBASE III PLUS, versions 1.0 and 1.1
* Notes.......: Boxes.PRG converts a format file produced by CREATE SCREEN
* to a program to print the screen on the printer. Line- and
* box-drawing commands are converted to @...SAY commands.

CLOSE ALL
SET TALK OFF
SET SAFETY OFF
SET PROCEDURE TO Boxutil

* ---Filenames.
infile = SPACE(30) && Name of format file.
outfile = SPACE(30) && Name of program file.
workfile = "TEMPBOXZ.DBF" && Name of working file.
ndxfile = "TEMPBOXZ.NDX" && Name of index file.

* ---Characters in a single-line box.
stlcner = CHR(218) && Top left corner.
strcner = CHR(191) && Top right corner.
sblcner = CHR(192) && Bottom left corner.
sbrcner = CHR(217) && Bottom right corner.
sacross = CHR(196) && Horizontal line.
svert = CHR(179) && Vertical line.

* ---Characters in a double-line box.
dtlcner = CHR(201) && Top left corner.
dtrcner = CHR(187) && Top right corner.
dblcner = CHR(200) && Bottom left corner.
dbrcner = CHR(188) && Bottom right corner.
dacross = CHR(205) && Horizontal line.
dvert = CHR(186) && Vertical line.

* ---Counters.
pagec = 1 && Page counter.
dpagec = 0 && Page counter.
linec = 0 && Line counter.
mrec = 0 && Record counter.
tmrec = 0 && Record counter.

* ---Box descriptors.
tbox = " " && Type of box.

tc = 0 && Top column.
tr = 0 && Top row.
bc = 0 && Bottom column.
br = 0 && Bottom row.

* ---Number of lines for top margin. This number should
* ---be between 0 and 15 on a 8 1/2" x 11" sheet.
tmarg = 5

* ---MAIN PROGRAM.
CLEAR

* ---Get input (format) filename.
DO WHILE .T.
@ 2, 0 TO 4, 79 DOUBLE
@ 3, 1 CLEAR TO 3, 78
@ 3, 12 SAY "INPUT FORMAT FILE NAME : ";
GET infile
READ
IF LEN(TRIM(infile)) = 0
CLOSE ALL
CLEAR
RETURN
ENDIF
infile = UPPER(TRIM(infile))
infile = infile + IIF(".FMT" $ infile, "", ".FMT")
@ 3, 41 SAY LEFT(infile + SPACE(30), 30)
IF .NOT. FILE(infile)
@ 10, 0 TO 12, 79 DOUBLE
?? CHR(7)
@ 11, 1 CLEAR TO 11, 78
@ 11, 8 SAY "THIS FORMAT FILE DOES NOT EXIST ! --> " + infile
infile = SPACE(30)
LOOP
ENDIF
EXIT
ENDDO


* ---Get output (program) filename.
DO WHILE .T.
@ 5, 0 TO 7, 79 DOUBLE
@ 6, 1 CLEAR TO 6, 78
@ 6, 12 SAY "OUTPUT PROGRAM FILE NAME : ";
GET outfile
READ
IF LEN(TRIM(outfile)) = 0
CLOSE ALL
CLEAR
RETURN
ENDIF
outfile = UPPER(TRIM(outfile))
outfile = outfile + IIF(".PRG" $ outfile, "", ".PRG")
@ 6, 41 SAY LEFT(outfile + SPACE(30), 30)
IF FILE(outfile)
texist = .F.
?? CHR(7)
@ 10, 0 TO 12, 79 DOUBLE
@ 11, 1 SAY SPACE(78)
@ 11, 25 SAY "FILE EXISTS ! OVERWRITE ? ";
GET texist
READ
IF .NOT. texist
LOOP
outfile = SPACE(30)
ENDIF
ENDIF
EXIT
ENDDO

@ 10, 0 TO 12, 79 DOUBLE
@ 11, 1 CLEAR TO 11, 78
@ 11, 35 SAY "WORKING..."

USE &workfile
APPEND FROM &infile TYPE SDF
GO TOP

* ---Number the pages and renumber the lines.
* ---There are two REPLACE statements per loop, since we're
* ---putting two screen pages on a printed page.

DO WHILE .NOT. EOF()
* ---Screen 1 of 2
REPLACE Pagenum WITH pagec,;
Content WITH STUFF(Content, 3, 2,;
STR(VAL(SUBSTR(Content, 3, 2)) + tmarg, 2));
WHILE Content <> "READ"
IF EOF()
EXIT
ENDIF
SKIP 1
REPLACE Pagenum WITH pagec,;
Content WITH STUFF(Content, 3, 2,;
STR(VAL(SUBSTR(Content, 3, 2)) + tmarg + 25, 2));
WHILE Content <> "READ"
pagec = pagec + 1
IF .NOT. EOF()
SKIP 1
ENDIF
ENDDO

* ---Change GETS to SAYS.
REPLACE Content WITH STUFF(Content, 11, 3, "SAY") ;
FOR SUBSTR(Content, 11, 3) = "GET"

* ---Delete READ Statements.
DELETE FOR AT("READ", content) = 1

* ---Translate boxes and lines.
GO TOP
mrec = RECCOUNT() + 1
DO WHILE RECNO() < mrec
IF AT("TO", Content) = 11

* ---Remember which record we're working on
tmrec = RECNO()

* ---Extract the coordinates of the top left and bottom
* ---right corners
tc = VAL(SUBSTR(Content, 7, 2))
tr = VAL(SUBSTR(Content, 3, 2))
bc = VAL(SUBSTR(Content, 18, 2))
* ---If the top left corner is on the second page, we have to
* ---move the bottom right corner down, too.
br = IIF((tr - tmarg) > 24, VAL(SUBSTR(Content, 14, 2)) + 25 + tmarg,;
VAL(SUBSTR(Content, 14, 2)) + tmarg)

* ---Call the box translation procedure.
pagec = pagenum
tbox = IIF(AT("DOUB", Content) = 24, "D", "S")
DO Box WITH tc, tr, bc, br, pagec, tbox

* ---Go back to the record we were working on, and DELETE it.
GOTO tmrec
DELETE
ENDIF
SKIP 1
ENDDO

* ---Add printer control commands.
APPEND BLANK
REPLACE Content WITH "SET DEVICE TO PRINT",;
Pagenum WITH 0
APPEND BLANK
REPLACE Content WITH "SET DEVICE TO SCREEN",;
Pagenum WITH 99
APPEND BLANK
REPLACE Content WITH "EJECT",;
Pagenum WITH 99

* ---Write to output file.
PACK
INDEX ON STR(Pagenum, 2, 0) + Content TO &ndxfile
USE &workfile INDEX &ndxfile
SET ALTERNATE TO &outfile
SET ALTERNATE ON
SET CONSOLE OFF
DO WHILE .NOT. EOF()
?? TRIM(Content)
?
SKIP
ENDDO
CLOSE ALTERNATE
SET CONSOLE ON
ZAP
CLOSE ALL
?? CHR(7)
@ 10, 0 TO 12, 79 DOUBLE
@ 11, 1 CLEAR TO 11, 78
@ 11, 36 SAY "COMPLETE"
RETURN
EOP: Boxes.PRG