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

 
Output of file : JOBSTAT.FRG contained in archive : DB4LESS3.ZIP
* Program............: D:\DBSYS\CLASSES\BT4W\JOBSTAT.FRG
* Date...............: 12-04-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 < 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

*-- Initialize group footer field variables
r_foot1=.F.
r_foot2=.F.
r_foot3=.F.

*-- Initialize calculated variables.
EMPNAME=""
JOBVAR=0

*-- 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

gl_newpage=.T. && ok to begin band on new page

*-- Initialize group break vars.
r_mvar4=JOBID
r_mvar5=EMPID

*-- Initialize summary variables.
JOBHOURS=0
JOBAMT=0
TOTHOURS=0
TOTAMT=0
r_msum1=0
DECLARE r_msum2[3]
STORE 0 TO r_msum2[1]
STORE 0 TO r_msum2[2],r_msum2[3]
DECLARE r_msum3[3]
STORE 0 TO r_msum3[1]
STORE 0 TO r_msum3[2],r_msum3[3]

*-- Initialize suppress repeated value variables.
r_msrv1=""

*-- Assign initial values to calculated variables.
EMPNAME=TRIM(LNAME)+', '+FNAME
JOBVAR=BIDPRICE-JOBAMT

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 Grphead

*-- File Loop
DO WHILE FOUND() .AND. .NOT. EOF() .AND. gl_prntflg
DO CASE
CASE .NOT. (JOBID = r_mvar4)
gn_level=4
CASE .NOT. (EMPID = r_mvar5)
gn_level=5
OTHERWISE
gn_level=0
ENDCASE
*-- test whether an expression didn't match
IF gn_level <> 0
DO Grpfoot WITH 100-gn_level
DO Grpinit
ENDIF
*-- Repeat group intros
IF gn_level <> 0
DO Grphead
ENDIF
DO Upd_Vars
*-- Detail lines
IF .NOT. gl_summary
DO Detail
ENDIF
r_foot1=JOBDESC
r_foot2=BIDPRICE
r_foot3=JOBVAR
CONTINUE
ENDDO

IF gl_prntflg
gn_level=3
DO Grpfoot WITH 97
DO Rsumm
ELSE
gn_level=3
DO Rsumm
DO Reset
RETURN
ENDIF

ON PAGE

ENDPRINTJOB

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

*-- Update summary fields and/or calculated fields in the detail band.
PROCEDURE Upd_Vars
EMPNAME=TRIM(LNAME)+', '+FNAME
*-- Summary calculation - Sum
JOBHOURS=JOBHOURS+HOURS
*-- Summary calculation - Sum
JOBAMT=JOBAMT+BILLING
*-- Summary calculation - Sum
TOTHOURS=TOTHOURS+HOURS
*-- Summary calculation - Sum
TOTAMT=TOTAMT+BILLING
*-- Summary calculation - Count
r_msum1=r_msum1+1
*-- Summary calculation - Average
r_msum2[1]=r_msum2[1]+1 && count
r_msum2[2]=r_msum2[2]+HOURS && sum
r_msum2[3]=r_msum2[2]/r_msum2[1] && average
*-- Summary calculation - Average
r_msum3[1]=r_msum3[1]+1 && count
r_msum3[2]=r_msum3[2]+BILLING && sum
r_msum3[3]=r_msum3[2]/r_msum3[1] && average
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

*-- Reset group break variables. Reinit summary
*-- fields with reset set to a particular group band.
PROCEDURE Grpinit
IF gn_level <= 4
JOBHOURS=0
JOBAMT=0
ENDIF
IF gn_level <= 4
r_mvar4=JOBID
ENDIF
IF gn_level <= 5
r_mvar5=EMPID
ENDIF
RETURN
* EOP: Grpinit

*-- Reset summary fields (on page) and suppress repeated values.
PROCEDURE Pageinit
r_msrv1=""
RETURN
* EOP: Pageinit

*-- Process Group Intro bands during group breaks
PROCEDURE Grphead
IF EOF()
RETURN
ENDIF
gl_widow=.T. && enable widow checking
IF gn_level <= 4
DO Head4
ENDIF
gn_level=0
RETURN
* EOP: Grphead.PRG

*-- Process Group Summary bands during group breaks
PROCEDURE Grpfoot
PARAMETER ln_level
IF ln_level >= 96
DO Foot96
ENDIF
RETURN
* EOP: Grpfoot.PRG

PROCEDURE Pghead
*-- Print HEADING parameter ie. REPORT FORM HEADING
IF .NOT. gl_plain .AND. gn_length > 0
?? gc_heading FUNCTION "I;V"+LTRIM(STR(_rmargin-_lmargin))
?
ENDIF
RETURN
* EOP: Pghead


PROCEDURE Head4
IF gn_level=1
RETURN
ENDIF
IF .NOT. gl_newpage
gl_newpage=.T.
EJECT PAGE
ENDIF
IF 20 < _plength
IF (gl_widow .AND. _plineno+20 > gn_atline) ;
.OR. (gl_widow .AND. _plineno+19 > gn_atline)
EJECT PAGE
ENDIF
ENDIF
?? "Report Date:" AT 0,
?? gd_date AT 13
?
?? "Time:" AT 7,
?? gc_time FUNCTION "T" AT 13
?
?
?
?? "JOB STATUS REPORT" AT 31
?
?
?
?? ;
"±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±";
+ "±±±±±±±±±";
AT 0
?
?
DEFINE BOX FROM 2 TO 65 HEIGHT 7 SINGLE
?
?
?? "JOB:" AT 4,
?? JOBDESC FUNCTION "T" AT 14
?
?
?? "CUSTOMER:" AT 4,
?? CUSTNAME FUNCTION "T" AT 14
?
?
?
?
?
?? "STAFF MEMBER" AT 8,
?? "DATE" AT 39,
?? "HOURS" AT 51,
?? "AMOUNT" AT 64
?
?
gl_newpage=.F.
RETURN

gl_newpage=.F.

PROCEDURE Detail
?? IIF(r_msrv1 <> EMPNAME,EMPNAME,"") FUNCTION "T" PICTURE "XXXXXXXXXXXXXXXXXXXXXXXXXX" AT 8,
IF .NOT. (r_msrv1 = EMPNAME)
r_msrv1=EMPNAME
ENDIF
?? DATE AT 36,
?? HOURS PICTURE "9,999.99" AT 49,
?? BILLING PICTURE "9999,999.99" AT 60
?
gl_newpage=.F.
RETURN
* EOP: Detail

gl_newpage=.F.

PROCEDURE Foot96
JOBVAR=BIDPRICE-JOBAMT
?
DEFINE BOX FROM 3 TO 72 HEIGHT 12 SINGLE
?
?
?? "JOB:" AT 5,
?? r_foot1 FUNCTION "T" AT 10
?
?
?? "TO DATE:" AT 36,
?? JOBHOURS PICTURE "9,999.99" AT 49,
?? JOBAMT PICTURE "9999,999.99" AT 60
?
?
?? "BID PRICE:" AT 36,
?? r_foot2 PICTURE "9999,999.99" AT 60
?
?? "-----------" AT 60
?
?
?? "VARIANCE:" AT 36,
?? r_foot3 PICTURE "9999,999.99" AT 60
?

?
?
?
gl_newpage=.F.
RETURN

PROCEDURE Rsumm
?? "Report Date:" AT 0,
?? gd_date AT 13
?
?? "Time:" AT 7,
?? gc_time FUNCTION "T" AT 13
?
?
?
?? "JOB STATUS REPORT SUMMARY" AT 27
?
?
?
?? ;
"±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±";
+ "±±±±±±±±±";
AT 0
?
?
DEFINE BOX FROM 30 TO 72 HEIGHT 11 DOUBLE
?
?
?? "TOTAL TO DATE:" AT 32,
?? TOTHOURS PICTURE "9,999.99" AT 49,
?? TOTAMT PICTURE "9999,999.99" AT 60
?
?
?? "ÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ" AT 31
?
?
?? "TIME SLIPS:" AT 32,
?? r_msum1 PICTURE "999" AT 44
?
?
?? "AVG TO DATE:" AT 32,
?? r_msum2[3] PICTURE "9,999.99" AT 49,
?? r_msum3[3] PICTURE "9999,999.99" AT 60
?
?
gl_fandl=.F. && last page finished
?
RETURN
* EOP: Rsumm

PROCEDURE Pgfoot
PRIVATE _box
gl_widow=.F. && disable widow checking
EJECT PAGE
gl_newpage=.T.
*-- is the page number greater than the ending page
IF _pageno > _pepage
GOTO BOTTOM
SKIP
gn_level=0
ENDIF
IF gl_fandl
DO Pageinit
ENDIF
IF .NOT. gl_plain .AND. gl_fandl
DO Pghead
ENDIF
IF gn_level = 0 .AND. gl_fandl
gn_level=1
DO Grphead
ENDIF
gl_widow=.T. && enable widow checking
RETURN
* EOP: Pgfoot

*-- Process page break when PLAIN option is used.
PROCEDURE Pgplain
PRIVATE _box
EJECT PAGE
IF gl_fandl
DO Pageinit
ENDIF
IF gn_level = 0 .AND. gl_fandl
gn_level=1
DO Grphead
ENDIF
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



  3 Responses to “Category : Dbase (Clipper, FoxBase, etc) Languages Source Code
Archive   : DB4LESS3.ZIP
Filename : JOBSTAT.FRG

  1. Very nice! Thank you for this wonderful archive. I wonder why I found it only now. Long live the BBS file archives!

  2. This is so awesome! 😀 I’d be cool if you could download an entire archive of this at once, though.

  3. But one thing that puzzles me is the “mtswslnkmcjklsdlsbdmMICROSOFT” string. There is an article about it here. It is definitely worth a read: http://www.os2museum.com/wp/mtswslnk/