Power-Programmierung/CD1.mdf/xbase/library/dbase/dict/dict.prn

Text File | 1986-02-18 | 3.7 KB | 127 lines

* DICT.PRN
* Paul Ferrara [70075,252]
* Bill Lonborg [70045,1237]
* Last Change: 02-17-86 00:05
*
IF FILE("PARAM.MEM")
   RESTORE FROM param ADDITIVE
ELSE
   STORE CHR(14) TO mprintwide
   STORE 80 TO mpagewdth
   STORE 66 TO mpagelen
ENDIF
SET COLOR TO &mtitl./&mnorb.,&menhf./&menhb.,&mbord
CLEAR
@  1, 0 SAY "PRINT THE DICTIONARY"
@  1,72 SAY date()
@  2, 0 SAY "═══════════════════════════════════════════════════════"
@  2,55 SAY "═════════════════════════"
@ 23, 0 SAY "═══════════════════════════════════════════════════════"
@ 23,55 SAY "═════════════════════════"
* prepare printer
SET COLOR TO &mblnk.*/&mnorb.,&menhf./&menhb.,&mbord
@  4,32 SAY "Prepare printer."
SET COLOR TO &mmess./&mnorb.,&menhf./&menhb.,&mbord
@  5,19 SAY 'Press "Q" to quit or any key to continue.'
SET COLOR TO &mnorf./&mnorb.,&menhf./&menhb.,&mbord
SET CONSOLE OFF
WAIT TO option
SET CONSOLE ON
IF UPPER(option)="Q"
   CLEAR
   RETURN
ENDIF
@  4, 0
@  5, 0
* test for existence of dictnary file
IF .NOT. FILE("DICTNARY.DBF")
   SET COLOR TO &mblnk.*/&mnorb.,&menhf./&menhb.,&mbord
   @ 20,28 SAY "Dictionary file missing."
   SET COLOR TO &mmess./&mnorb.,&menhf./&menhb.,&mbord
   @ 21,24 SAY "Press any key to return to menu."
   SET COLOR TO &mnorf./&mnorb.,&menhf./&menhb.,&mbord
   SET CONSOLE OFF
   WAIT
   SET CONSOLE ON
   CLEAR
   RETURN
ENDIF
SELECT 1
USE dictnary
SET COLOR TO &mblnk.*/&mnorb.,&menhf./&menhb.,&mbord
@  4,32 SAY "Printing report."
SET COLOR TO &mnorf./&mnorb.,&menhf./&menhb.,&mbord
SET DEVICE TO PRINT
SET MARGIN TO INT(mpagewdth-80)/2
STORE mpagelen-2 TO mrow
STORE 1 TO mpage
* begin printing report
DO WHILE .NOT. EOF()
   STORE file_name to mfilename
   STORE 1 TO mttlwidth
   STORE 1 TO mfieldno
   STORE .T. TO mnewfile
   DO WHILE file_name=mfilename .AND. .NOT. EOF()
      IF mrow>=(mpagelen-3)
         @  1, 0 SAY date()
         @  2, 0 SAY "Page"+STR(mpage,2)
         @  3,31 SAY "Dictionary Listing"
         STORE mpage+1 TO mpage
         STORE 5 TO mrow
         STORE .T. TO mnewpage
      ENDIF
      IF field_type="X"
         IF mrow>(mpagelen-11)
            STORE mpagelen-2 TO mrow
            LOOP
         ENDIF
         @ mrow,   0 SAY "Filename:"
         @ mrow,  19 SAY mprintwide+TRIM(file_name)+".DBF"
         @ mrow+1, 0 SAY "File description:"
         @ mrow+1,19 SAY field_desc
         STORE mrow+3 TO mrow
         STORE .T. TO mnewfile
         SKIP
      ENDIF
      IF mnewpage .OR. mnewfile
         @ mrow,   0 SAY "FLD FIELD NAME TYPE WIDTH DEC                 FIELD DESCRIPTION"
         @ mrow+1, 0 SAY "=== ========== ==== ===== === =================================================="
         STORE mrow+2 TO mrow
         STORE .F. TO mnewpage, mnewfile
      ENDIF
      @ mrow, 0 SAY mfieldno PICTURE "999"
      @ mrow, 4 SAY field_name
      * print abbr file type
      DO CASE
         CASE field_type="C"
            @ mrow,15 SAY "Char"
         CASE field_type="N"
            @ mrow,15 SAY "Num"
         CASE field_type="D"
            @ mrow,15 SAY "Date"
         CASE field_type="L"
            @ mrow,15 SAY "Log"
         CASE field_type="M"
            @ mrow,15 SAY "Memo"
      ENDCASE
      @ mrow,22 SAY field_len
      * if numeric field type, print decimals
      IF field_type="N"
         @ mrow,26 SAY field_dec
      ENDIF
      @ mrow,30 SAY field_desc
      STORE mttlwidth+field_len TO mttlwidth
      SKIP
      STORE mfieldno+1 TO mfieldno
      STORE mrow+1 TO mrow
   ENDDO
   @ mrow, 0 SAY "** Total **"
   @ mrow,21 SAY mttlwidth PICTURE "9999"
   STORE mrow+3 TO mrow
ENDDO
EJECT
SET DEVICE TO SCREEN
CLEAR
CLOSE DATABASES
RETURN