Category : Dbase (Clipper, FoxBase, etc) Languages Source Code
Archive   : DB4LESS3.ZIP
Filename : FUNCODE.FRG

* Program............: D:\DBSYS\CLASSES\BT4W\FUNCODE.FRG
* Date...............: 11-17-88
* Versions...........: dBASE IV, Report 1
*
* 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

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

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

IF _plength < 10
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



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

*-- Print Report

PRINTJOB

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

*-- File Loop
DO WHILE FOUND() .AND. .NOT. EOF() .AND. gl_prntflg
DO Upd_Vars
*-- Detail lines
IF .NOT. gl_summary
DO Detail
ENDIF
CONTINUE
ENDDO

IF gl_prntflg
ELSE
DO Reset
RETURN
ENDIF

ON PAGE

ENDPRINTJOB

DO Reset
RETURN
* EOP: D:\DBSYS\CLASSES\BT4W\FUNCODE.FRG

*-- Update summary fields and/or calculated fields in the detail band.
PROCEDURE Upd_Vars
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
?
IF .NOT. gl_plain
?? "Page No." AT 0,
?? _pageno PICTURE "999" AT 9
ENDIF
*-- Print HEADING parameter ie. REPORT FORM HEADING
IF .NOT. gl_plain .AND. gn_length > 0
?? " "
?? gc_heading FUNCTION "I;V"+;
LTRIM(STR(_rmargin-_lmargin-(_pcolno*2+2)))
ENDIF
IF .NOT. gl_plain
?
ENDIF
IF .NOT. gl_plain
?? gd_date AT 0
?
ENDIF
?
?? "FUNCTION CODE REPORT" AT 30
?
?
?? "CODE" AT 18,
?? "DESCRIPTION" AT 27
?
?? "²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²" AT 18
?
RETURN
* EOP: Pghead


PROCEDURE Detail
?? FUNCODE FUNCTION "T" AT 18,
?? FUNDESC FUNCTION "T" AT 27
?
RETURN
* EOP: Detail


PROCEDURE Pgfoot
PRIVATE _box
gl_widow=.F. && disable widow checking
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
DO Pghead
ENDIF
gl_widow=.T. && enable widow checking
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