DOS Wares/doswares.zip/doswares/DATABASE/DBASE5/SAMPLES.ZIP/ACCT_REC.FRG

Text File | 1994-06-24 | 6.2 KB | 298 lines

* Program............: acct_rec.FRG
* Date...............: 6-22-94
* Versions...........: dBASE 5.0, Report
*
* Notes:
* ------
* Prior to running this procedure with the DO command
* it is necessary use LOCATE because the CONTINUE
* statement is in the main loop.
*
*-- Parameters
PARAMETERS gl_noeject, gl_plain, gl_summary, gc_heading, gc_extra
** The first three parameters are of type Logical.
** The fourth parameter is a string.  The fifth is extra.
PRIVATE _peject, _wrap, ll_heading, ll_temp, ll_toprint
ll_heading = .F.
ll_toprint = (SET("PRINTER") = "ON")

*-- Test for no records found
IF EOF() .OR. .NOT. FOUND()
   RETURN
ENDIF

*-- turn word wrap mode off
_wrap=.F.

IF _plength < (_pspacing * 4 + 1) + (_pspacing * 3 + 1) + 2
   SET DEVICE TO SCREEN
   DEFINE WINDOW gw_report FROM 7,17 TO 11,62 DOUBLE
   ACTIVATE WINDOW gw_report
   @ 0,1 SAY "Increase the page length for this report."
   @ 2,1 SAY "Press any key ..."
   x=INKEY(0)
   DEACTIVATE WINDOW gw_report
   RELEASE WINDOW gw_report
   RETURN
ENDIF

_plineno=0          && set lines to zero
*-- NOEJECT parameter
IF gl_noeject
   IF _peject="BEFORE"
      _peject="NONE"
   ENDIF
   IF _peject="BOTH"
      _peject="AFTER"
   ENDIF
ENDIF

*-- Set-up environment
ON ESCAPE DO Prnabort
IF SET("TALK")="ON"
   SET TALK OFF
   gc_talk="ON"
ELSE
   gc_talk="OFF"
ENDIF
gc_space=SET("SPACE")
SET SPACE OFF
gc_time=TIME()      && system time for predefined field
gd_date=DATE()      && system date  "    "    "     "
gl_fandl=.F.        && first and last page flag
gl_prntflg=.T.      && Continue printing flag
gl_widow=.T.        && flag for checking widow bands
gn_length=LEN(gc_heading)  && store length of the HEADING
gn_level=2          && current band being processed
gn_page=_pageno     && grab current page number
gn_pspace=_pspacing && get current print spacing


*-- Set up procedure for page break
gn_atline=_plength - (_pspacing * 3 + 1)
ON PAGE AT LINE gn_atline EJECT PAGE

*-- Print Report

PRINTJOB

*-- Initialize summary variables.
r_msum1=0
r_msum2=0

IF gl_plain
   ON PAGE AT LINE gn_atline DO Pgplain
ELSE
   ON PAGE AT LINE gn_atline DO Pgfoot
ENDIF

DO Pghead

gl_fandl=.T.        && first physical page started

DO Rintro

*-- File Loop
DO WHILE FOUND() .AND. .NOT. EOF() .AND. gl_prntflg
   gn_level=0
   *-- Detail lines
   IF gl_summary
      DO Upd_Vars
   ELSE
      DO __Detail
   ENDIF
   gl_widow=.T.         && enable widow checking
   CONTINUE
ENDDO

IF gl_prntflg
   DO Rsumm
   IF _plineno <= gn_atline
      EJECT PAGE
   ENDIF
ELSE
   DO Rsumm
   DO Reset
   RETURN
ENDIF

ON PAGE

ENDPRINTJOB

DO Reset
RETURN
* EOP: acct_rec.FRG

*-- Update summary fields and/or calculated fields.
PROCEDURE Upd_Vars
*-- Sum
r_msum1=r_msum1+OLDBALANCE
*-- Sum
r_msum2=r_msum2+AMT_OF_BIL
RETURN
* EOP: Upd_Vars

*-- Set flag to get out of DO WHILE loop when escape is pressed.
PROCEDURE Prnabort
gl_prntflg=.F.
RETURN
* EOP: Prnabort

PROCEDURE Pghead
PRIVATE ll_heading, ln_width
ll_heading = .T.
ln_width = _rmargin - _lmargin
?
*-- Print HEADING parameter - if it doesn't fit on line one
*-- Value added to gn_length is the last column on line one times two
IF .NOT. gl_plain .AND. gn_length + 160 > ln_width
   ?? gc_heading FUNCTION "I;V"+LTRIM(STR(ln_width))
   ?
   ll_heading = .F.
ENDIF

?? IIF(gl_plain,'',gd_date) AT 0,;
 IIF(gl_plain,'' , "PAGE  " ) AT 70,;
 IIF(gl_plain,'',_pageno) PICTURE "999"

*-- Print HEADING parameter - if it fits on line one
IF .NOT. gl_plain .AND. gn_length > 0 .AND. ll_heading
   ?? " "
   ?? gc_heading FUNCTION "I;V"+LTRIM(STR(ln_width-(_pcolno*2)))
ENDIF
?
?
?
RETURN
* EOP: Pghead

PROCEDURE Rintro
?
DEFINE BOX FROM 24 TO 57 HEIGHT 4 DOUBLE
?
?? "A-T FURNITURE INDUSTRIES" STYLE "B" AT 29
?
?? "ACCOUNTS RECEIVABLE REPORT" STYLE "B" AT 28
?
?
?
RETURN
* EOP: Rintro

PROCEDURE __Detail
IF 12 * gn_pspace < gn_atline - (_pspacing * 4 + 1)
   IF gl_widow .AND. _plineno+12 * gn_pspace > gn_atline + 1
      EJECT PAGE
   ENDIF
ENDIF
DO Upd_Vars
?? ;
"──────────────────────────────────────────────────────────────────────";
+ "─────────";
AT 0
?
?? "INVOICE NUMBER: " STYLE "B" AT 0,;
 Invoice_no FUNCTION "T" STYLE "B" ,;
 "DATE: " STYLE "B" AT 65,;
 Dat_of_bil STYLE "B"
?
?? "CUSTOMER ID: " AT 0,;
 Cust_id FUNCTION "T"
?
?? "PREVIOUS INVOICE #: " AT 6,;
 Invoic_old FUNCTION "T" ,;
 "SENT: " AT 40,;
 Dat_lstbil
?
?? "PREVIOUS INVOICE: $ " AT 6,;
 Amt_lstbil PICTURE "999,999.99"
?
?? "AMOUNT PAID:        " AT 6,;
 Amt_lst_pd PICTURE "999,999.99"
?
?? "----------" AT 26
?
?? "PREVIOUS BALANCE: $ " AT 6,;
 Oldbalance PICTURE "999,999.99"
?
?? "CURRENT ORDERS:     " AT 6,;
 Amt_of_cur PICTURE "999,999.99" ,;
 "COMMENTS: " AT 40,;
 Comments FUNCTION "T"
?
?? "==========" AT 26
?
?? "CURRENT INVOICE:  $ " AT 6,;
 Amt_of_bil PICTURE "999,999.99" ,;
 "NOTES: " AT 40,;
 Notes FUNCTION "T"
?
?
RETURN
* EOP: __Detail

PROCEDURE Rsumm
?
?? ;
"══════════════════════════════════════════════════════════════════════";
+ "═════════";
AT 0
?
?? "TOTAL AMOUNT OF PREVIOUS BALANCES:  $ " AT 0,;
 r_msum1 PICTURE "999,9999.99"
?
?? "TOTAL AMOUNT OF CURRENT INVOICES:   $ " AT 0,;
 r_msum2 PICTURE "999,9999.99"
?
?? ;
"══════════════════════════════════════════════════════════════════════";
+ "═════════";
AT 0
gl_fandl=.F.        && last page finished
?
RETURN
* EOP: Rsumm

PROCEDURE Pgfoot
PRIVATE _box, _pspacing
gl_widow=.F.         && disable widow checking
_pspacing=1
?
IF .NOT. gl_plain
   _pspacing=gn_pspace
   ?
   ?? "PREPARED BY FINANCIAL DEPARTMENT" AT 26
   ?
ENDIF
EJECT PAGE
*-- is the page number greater than the ending page
IF _pageno > _pepage
   GOTO BOTTOM
   SKIP
   gn_level=0
ENDIF
IF .NOT. gl_plain .AND. gl_fandl
   _pspacing=gn_pspace
   DO Pghead
ENDIF
RETURN
* EOP: Pgfoot

*-- Process page break when PLAIN option is used.
PROCEDURE Pgplain
PRIVATE _box
EJECT PAGE
RETURN
* EOP: Pgplain

*-- Reset dBASE environment prior to calling report
PROCEDURE Reset
SET SPACE &gc_space.
SET TALK &gc_talk.
ON ESCAPE
ON PAGE
RETURN
* EOP: Reset