Category : Dbase (Clipper, FoxBase, etc) Languages Source Code
Archive   : DB4LESS3.ZIP
Filename : EMP.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 < 8
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 calculated variables.
ACT=""
*-- 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
*-- Assign initial values to calculated variables.
ACT=iif(active,'ACTIVE','NOT ACTIVE')
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\EMP.FRG
*-- Update summary fields and/or calculated fields in the detail band.
PROCEDURE Upd_Vars
ACT=iif(active,'ACTIVE','NOT ACTIVE')
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
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
?? "EMPLOYEE REPORT" AT 30
?
?
?? ;
"±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±";
+ "±±±±±±±±±±";
AT 0
?
RETURN
* EOP: Pghead
PROCEDURE Detail
IF 6 < _plength
IF gl_widow .AND. _plineno+5 > gn_atline
EJECT PAGE
ENDIF
ENDIF
?
?? "±±" AT 7,
?? FNAME FUNCTION "T" AT 12,
?? " " ,
?? LNAME FUNCTION "T"
?
?? "±±" AT 7,
?? ADDRESS FUNCTION "T" AT 12,
?? ACT FUNCTION "T" PICTURE "XXXXXXXXXX" AT 62
?
?? "±±" AT 7,
?? CITY FUNCTION "T" AT 12,
?? "," ,
?? STATE FUNCTION "T" ,
?? ZIP FUNCTION "T" AT 42
?
?? "±±" AT 7
?
?? "±±" AT 7,
?? "ID" AT 12,
?? EMPID FUNCTION "T" AT 15,
?? "Dept" AT 23,
?? DEPT FUNCTION "T" AT 28,
?? "Employment Date" AT 36,
?? EMPDATE AT 52
?
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
Very nice! Thank you for this wonderful archive. I wonder why I found it only now. Long live the BBS file archives!
This is so awesome! 😀 I’d be cool if you could download an entire archive of this at once, though.
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/