home *** CD-ROM | disk | FTP | other *** search
/ DOS Wares / doswares.zip / doswares / DATABASE / DBASE5 / SAMPLES.ZIP / EMPLOYEE.FRG < prev    next >
Encoding:
Text File  |  1994-06-24  |  6.2 KB  |  308 lines
  1. * Program............: employee.FRG
  2. * Date...............: 6-22-94
  3. * Versions...........: dBASE 5.0, Report
  4. *
  5. * Notes:
  6. * ------
  7. * Prior to running this procedure with the DO command
  8. * it is necessary use LOCATE because the CONTINUE
  9. * statement is in the main loop.
  10. *
  11. *-- Parameters
  12. PARAMETERS gl_noeject, gl_plain, gl_summary, gc_heading, gc_extra
  13. ** The first three parameters are of type Logical.
  14. ** The fourth parameter is a string.  The fifth is extra.
  15. PRIVATE _peject, _wrap, ll_heading, ll_temp, ll_toprint
  16. ll_heading = .F.
  17. ll_toprint = (SET("PRINTER") = "ON")
  18.  
  19. *-- Test for no records found
  20. IF EOF() .OR. .NOT. FOUND()
  21.    RETURN
  22. ENDIF
  23.  
  24. *-- turn word wrap mode off
  25. _wrap=.F.
  26.  
  27. IF _plength < (_pspacing * 3 + 1) + (_pspacing + 1) + 2
  28.    SET DEVICE TO SCREEN
  29.    DEFINE WINDOW gw_report FROM 7,17 TO 11,62 DOUBLE
  30.    ACTIVATE WINDOW gw_report
  31.    @ 0,1 SAY "Increase the page length for this report."
  32.    @ 2,1 SAY "Press any key ..."
  33.    x=INKEY(0)
  34.    DEACTIVATE WINDOW gw_report
  35.    RELEASE WINDOW gw_report
  36.    RETURN
  37. ENDIF
  38.  
  39. _plineno=0          && set lines to zero
  40. *-- NOEJECT parameter
  41. IF gl_noeject
  42.    IF _peject="BEFORE"
  43.       _peject="NONE"
  44.    ENDIF
  45.    IF _peject="BOTH"
  46.       _peject="AFTER"
  47.    ENDIF
  48. ENDIF
  49.  
  50. *-- Set-up environment
  51. ON ESCAPE DO Prnabort
  52. IF SET("TALK")="ON"
  53.    SET TALK OFF
  54.    gc_talk="ON"
  55. ELSE
  56.    gc_talk="OFF"
  57. ENDIF
  58. gc_space=SET("SPACE")
  59. SET SPACE OFF
  60. gc_time=TIME()      && system time for predefined field
  61. gd_date=DATE()      && system date  "    "    "     "
  62. gl_fandl=.F.        && first and last page flag
  63. gl_prntflg=.T.      && Continue printing flag
  64. gl_widow=.T.        && flag for checking widow bands
  65. gn_length=LEN(gc_heading)  && store length of the HEADING
  66. gn_level=2          && current band being processed
  67. gn_page=_pageno     && grab current page number
  68. gn_pspace=_pspacing && get current print spacing
  69.  
  70.  
  71. *-- Set up procedure for page break
  72. gn_atline=_plength - (_pspacing + 1)
  73. ON PAGE AT LINE gn_atline EJECT PAGE
  74.  
  75. *-- Print Report
  76.  
  77. PRINTJOB
  78.  
  79. *-- Initialize summary variables.
  80. r_msum1=0
  81.  
  82. IF gl_plain
  83.    ON PAGE AT LINE gn_atline DO Pgplain
  84. ELSE
  85.    ON PAGE AT LINE gn_atline DO Pgfoot
  86. ENDIF
  87.  
  88. DO Pghead
  89.  
  90. gl_fandl=.T.        && first physical page started
  91.  
  92. DO Rintro
  93.  
  94. *-- File Loop
  95. DO WHILE FOUND() .AND. .NOT. EOF() .AND. gl_prntflg
  96.    gn_level=0
  97.    *-- Detail lines
  98.    IF gl_summary
  99.       DO Upd_Vars
  100.    ELSE
  101.       DO __Detail
  102.    ENDIF
  103.    gl_widow=.T.         && enable widow checking
  104.    CONTINUE
  105. ENDDO
  106.  
  107. IF gl_prntflg
  108.    DO Rsumm
  109.    IF _plineno <= gn_atline
  110.       EJECT PAGE
  111.    ENDIF
  112. ELSE
  113.    DO Rsumm
  114.    DO Reset
  115.    RETURN
  116. ENDIF
  117.  
  118. ON PAGE
  119.  
  120. ENDPRINTJOB
  121.  
  122. DO Reset
  123. RETURN
  124. * EOP: employee.FRG
  125.  
  126. *-- Update summary fields and/or calculated fields.
  127. PROCEDURE Upd_Vars
  128. *-- Count
  129. r_msum1=r_msum1+1
  130. RETURN
  131. * EOP: Upd_Vars
  132.  
  133. *-- Set flag to get out of DO WHILE loop when escape is pressed.
  134. PROCEDURE Prnabort
  135. gl_prntflg=.F.
  136. RETURN
  137. * EOP: Prnabort
  138.  
  139. PROCEDURE Pghead
  140. PRIVATE ll_heading, ln_width
  141. ll_heading = .T.
  142. ln_width = _rmargin - _lmargin
  143. ?
  144. *-- Print HEADING parameter - if it doesn't fit on line one
  145. *-- Value added to gn_length is the last column on line one times two
  146. IF .NOT. gl_plain .AND. gn_length + 158 > ln_width
  147.    ?? gc_heading FUNCTION "I;V"+LTRIM(STR(ln_width))
  148.    ?
  149.    ll_heading = .F.
  150. ENDIF
  151.  
  152. ?? IIF(gl_plain,'',gd_date) AT 0,;
  153.  IIF(gl_plain,'' , "PAGE " ) AT 70,;
  154.  IIF(gl_plain,'',_pageno) PICTURE "999" 
  155.  
  156. *-- Print HEADING parameter - if it fits on line one
  157. IF .NOT. gl_plain .AND. gn_length > 0 .AND. ll_heading
  158.    ?? " "
  159.    ?? gc_heading FUNCTION "I;V"+LTRIM(STR(ln_width-(_pcolno*2)))
  160. ENDIF
  161. ?
  162. ?
  163. RETURN
  164. * EOP: Pghead
  165.  
  166. PROCEDURE Rintro
  167. DEFINE BOX FROM 23 TO 51 HEIGHT 4 DOUBLE
  168. ?
  169. ?? "A-T FURNITURE INDUSTRIES" AT 26
  170. ?
  171. ?? "EMPLOYEE REPORT" AT 30
  172. ?
  173. ?
  174. ?
  175. ?? ;
  176. "══════════════════════════════════════════════════════════════════════";
  177. + "══════════";
  178. AT 0
  179. ?
  180. RETURN
  181. * EOP: Rintro
  182.  
  183. PROCEDURE __Detail
  184. IF 11 * gn_pspace < gn_atline - (_pspacing * 3 + 1)
  185.    IF gl_widow .AND. _plineno+11 * gn_pspace > gn_atline + 1
  186.       EJECT PAGE
  187.    ENDIF
  188. ENDIF
  189. DO Upd_Vars
  190. ?
  191. ?? Lastname FUNCTION "T" AT 0,;
  192.  ", " ,;
  193.  Firstname FUNCTION "T" ,;
  194.  " " ,;
  195.  Initial FUNCTION "T" ,;
  196.  "." ,;
  197.  "ID:" AT 38,;
  198.  Emp_id FUNCTION "T" AT 42,
  199. ?? Phone FUNCTION "T" AT 57
  200. ?
  201. ?? Address1 FUNCTION "T" AT 0,;
  202.  " " ,;
  203.  Address2 FUNCTION "T" 
  204. ?
  205. ?? City FUNCTION "T" AT 0,;
  206.  ", " ,;
  207.  State FUNCTION "T" ,;
  208.  " " ,;
  209.  Zip FUNCTION "T" 
  210. ?
  211. ?? "DEPARTMENT:" AT 5,;
  212.  Department FUNCTION "T" AT 17,;
  213.  "SALARY:  $" AT 57,;
  214.  Salary PICTURE "99,999.99" AT 71
  215. ?
  216. ?? Title FUNCTION "T" AT 17,;
  217.  Specialty FUNCTION "T" AT 38,;
  218.  "COMMISSION RATE:  " AT 57,;
  219.  Rate PICTURE "99.9" ,;
  220.  "%" 
  221. ?
  222. ?? "DATE HIRED: " AT 5,;
  223.  Date_hired ,;
  224.  "DEGREE:" AT 38,;
  225.  Degree FUNCTION "T" AT 46,;
  226.  "YEARS EXPERIENCE: " AT 57,;
  227.  Yrs_exper PICTURE "99.9" 
  228. ?
  229. ?? "EXEMPT: " AT 5,;
  230.  Exempt PICTURE "Y" ,;
  231.  "FULLTIME:" AT 38,;
  232.  Full_time PICTURE "Y" AT 50
  233. ?
  234. ?? "AWARDS: " AT 5,;
  235.  Awards FUNCTION "T" ,;
  236.  "LABORGRADE:" AT 38,;
  237.  Laborgrade PICTURE "9" AT 50
  238. ?
  239. ?? "COMMENTS: " AT 5,;
  240.  Comments FUNCTION "T" 
  241. ?
  242. ?? ;
  243. "──────────────────────────────────────────────────────────────────────";
  244. + "──────────";
  245. AT 0
  246. ?
  247. RETURN
  248. * EOP: __Detail
  249.  
  250. PROCEDURE Rsumm
  251. ?
  252. ?
  253. ?? ;
  254. "──────────────────────────────────────────────────────────────────────";
  255. + "──────────";
  256. AT 0
  257. ?
  258. ?? "NUMBER OF EMPLOYEES:" AT 0,;
  259.  r_msum1 PICTURE "99,999" AT 21
  260. ?
  261. ?? ;
  262. "──────────────────────────────────────────────────────────────────────";
  263. + "──────────";
  264. AT 0
  265. gl_fandl=.F.        && last page finished
  266. ?
  267. RETURN
  268. * EOP: Rsumm
  269.  
  270. PROCEDURE Pgfoot
  271. PRIVATE _box, _pspacing
  272. gl_widow=.F.         && disable widow checking
  273. _pspacing=1
  274. ?
  275. IF .NOT. gl_plain
  276.    _pspacing=gn_pspace
  277. ENDIF
  278. EJECT PAGE
  279. *-- is the page number greater than the ending page
  280. IF _pageno > _pepage
  281.    GOTO BOTTOM
  282.    SKIP
  283.    gn_level=0
  284. ENDIF
  285. IF .NOT. gl_plain .AND. gl_fandl
  286.    _pspacing=gn_pspace
  287.    DO Pghead
  288. ENDIF
  289. RETURN
  290. * EOP: Pgfoot
  291.  
  292. *-- Process page break when PLAIN option is used.
  293. PROCEDURE Pgplain
  294. PRIVATE _box
  295. EJECT PAGE
  296. RETURN
  297. * EOP: Pgplain
  298.  
  299. *-- Reset dBASE environment prior to calling report
  300. PROCEDURE Reset
  301. SET SPACE &gc_space.
  302. SET TALK &gc_talk.
  303. ON ESCAPE
  304. ON PAGE
  305. RETURN
  306. * EOP: Reset
  307.  
  308.