home *** CD-ROM | disk | FTP | other *** search
/ Liren Large Software Subsidy 5 / 05.iso / a / a031 / samples.exe / EMP_REPT.PRG < prev    next >
Encoding:
Text File  |  1992-03-10  |  7.3 KB  |  273 lines
  1. *****************************************************************************
  2. * PROGRAM NAME: EMP_REPT.PRG
  3. *               SAMPLE CUSTOM REPORT - EMPLOYEES
  4. *               SAMPLE BUSINESS APPLICATION PROGRAM
  5. * LAST CHANGED: 01/05/89 03:36PM
  6. * WRITTEN BY:   Borland International Inc.
  7. *****************************************************************************
  8. *            FILES USED:
  9. *            Database = Employee.dbf
  10. *            Indexed  = Employee.mdx
  11. *              Tag used: Dept  (department+lastname+firstname+initial)
  12. *****************************************************************************
  13. ll_print = SET( "PRINTER" ) = "ON"
  14.  
  15. SET ORDER TO Dept
  16. GO TOP
  17.  
  18. ON ESCAPE print_flag = .F.   && If user presses Esc during printing, exit
  19.  
  20. * Set up environment
  21. SET CENTURY ON
  22.  
  23. * Initialize variables
  24. rpt_level   =  1               && Current report level being processed
  25. print_flag  = .T.              && Continue printing flag
  26. on_pg_line  =  0               && Line at which ON PAGE works
  27. STORE 0 TO pageno, salary_sum, salary_gt, number_emp, yrsexp_sum, yrsexp_avg
  28. group_brk = ""
  29. p_title = "Human Resources Report"
  30.  
  31. * Store line number to break page on
  32. on_pg_line = _plength - 5      && Page height minus footer and bottom margin
  33.  
  34. * Store current environment settings
  35. mplength  = _plength
  36. mploffset = _ploffset
  37. mlmargin  = _lmargin
  38. mrmargin  = _rmargin
  39. mwrap     = _wrap
  40. mpeject   = _peject
  41.  
  42. _pageno   = 1                  && Force internal page number to 1
  43.  
  44. IF ll_print
  45.    mppitch   = _ppitch
  46. ENDIF
  47.  
  48. * Set report characteristics
  49. *_plength  = 66
  50. _ploffset = 0
  51. _lmargin  = 0
  52. _rmargin  = 80
  53. _plineno  =  1
  54. _wrap     = .F.
  55. _peject   = "AFTER"
  56. IF ll_print
  57.    _ppitch   = "PICA"
  58. ENDIF
  59.  
  60. * Set up line number where page break procedure executes
  61. ON PAGE AT LINE on_pg_line DO Pg_break
  62.  
  63. *================================ Begin Print Job ===========================
  64. PRINTJOB
  65.    * Print page heading
  66.    DO Title
  67.    DO Pg_head
  68.    DO Brk_head
  69.    GO TOP
  70.    *============ File loop - process records in index order to end of file ==
  71.    *                    or until user presses Esc (print_flag = .F.)
  72.    SCAN WHILE print_flag
  73.       IF group_brk <> department
  74.          * Department changed, print break info
  75.          rpt_level = 1
  76.          DO Brk_data
  77.          DO Reinit
  78.          DO Brk_head
  79.       ELSE
  80.          * Department did not change
  81.          rpt_level = 0
  82.       ENDIF
  83.       * Print detail lines
  84.       DO Detail
  85.       * Perform break summary calculations
  86.       DO Det_calc
  87.    ENDSCAN
  88.    *
  89.    IF print_flag
  90.       DO Brk_data     && End of file, user did not press Esc to stop printing
  91.    ENDIF
  92.    * Finish report
  93.    DO Rpt_end
  94.    ON PAGE AT LINE on_pg_line DO Pg_foot
  95.    EJECT PAGE
  96. ENDPRINTJOB
  97. *================================ End of Print Job ==========================
  98.  
  99. * Reset environment
  100. _wrap     = mwrap
  101. _peject   = mpeject
  102. _plength  = mplength
  103. _ploffset = mploffset
  104. _lmargin  = mlmargin
  105. _rmargin  = mrmargin
  106. IF ll_print
  107.    _ppitch   = mppitch
  108. ENDIF
  109.  
  110. ON ESCAPE
  111. ON PAGE
  112. SET CENTURY OFF
  113. SET ORDER TO TAG Names
  114. RETURN
  115.  
  116. ************************** END OF MAIN REPORT PROCEDURE *********************
  117.  
  118. * UTILITY PROCEDURES
  119.  
  120. PROCEDURE Brk_data
  121.    * Print calculated data at department break
  122.    ?
  123.    ?? "HEADCOUNT:" STYLE "B" AT 0
  124.    ?? number_emp   PICTURE "999"
  125.    ?? "TOTAL:"     STYLE "B" AT 36
  126.    ?? "  $" AT 44
  127.    ?? salary_sum   PICTURE "999,999.99"
  128.    ?? " "
  129.    ?? "AVG:"       STYLE "B" AT 59
  130.    ??  yrsexp_avg  PICTURE "99.9"
  131.    ?? " yrs"
  132.    ? "AVG:"        STYLE "B" AT 36
  133.    ?? "  $" AT 44
  134.    ?? ROUND(salary_sum/number_emp,2)  PICTURE "999,999.99"
  135.    ?
  136.    * Accumulate salary totals
  137.    salary_gt  = salary_gt + salary_sum
  138.    * EJECT PAGE    && Uncomment if user wants each group to start on new page
  139. RETURN
  140.  
  141. PROCEDURE Brk_head
  142.    * Update break variable and print department break heading
  143.    group_brk = department
  144.    * Check whether current line is close to page footer (ON PAGE) location
  145.    IF  _plineno + 8 > on_pg_line
  146.       EJECT PAGE        && Start new page if too close
  147.    ELSE
  148.       ?
  149.       ? "Department" STYLE "BU" AT 0 ,": " STYLE "B"
  150.       ?? department  PICTURE "@T XXXXXXXXXXXXXXX"
  151.       IF rpt_level = 0
  152.          ?? " (Cont'd)" && Print continuation message if group continued
  153.                            && from previous page
  154.       ENDIF
  155.       ?
  156.       rpt_level = 0     && Reset level after printing department break                                 &&
  157.                          && heading
  158.     ENDIF
  159. RETURN
  160.  
  161. PROCEDURE Det_calc
  162.    * Calculate sums and averages for printing at department breaks
  163.    number_emp = number_emp + 1                  && Employee count
  164.    salary_sum = salary_sum + salary             && Salary summation
  165.    yrsexp_sum = yrsexp_sum + yrs_exper          && Yrs experience summation
  166.    yrsexp_avg = ROUND(yrsexp_sum/number_emp,1)  && Yrs experience average
  167. RETURN
  168.  
  169. PROCEDURE Detail
  170.    * Print report detail
  171.    * Check whether current line is close to page footer (ON PAGE) location
  172.    IF _plineno + 5 > on_pg_line
  173.       * Use new page if too close
  174.       EJECT PAGE
  175.    ENDIF
  176.    ?
  177.    ?? lastname  PICTURE "@T XXXXXXXXXXXXXXX" AT 0
  178.    ?? ", "
  179.    ?? firstname PICTURE "XXXXXXXXXX"
  180.    ?? title     PICTURE "XXXXXXXXXXXXXXX" AT 30
  181.    ?? "  $"
  182.    ?? salary    PICTURE "99,999.99" AT 48
  183.    ?? yrs_exper PICTURE "99.9" AT 63
  184.    ?? degree    PICTURE "XXX"  AT 73
  185.    ?  emp_id    AT 0
  186.    ?? specialty AT 30
  187.    IF rate <> 0
  188.       * Print rate only if rate is non-zero
  189.       ?? rate   PICTURE "99.9" AT 48
  190.       ?? " %"
  191.    ENDIF
  192.    ?
  193. RETURN
  194.  
  195. PROCEDURE Pg_break
  196.    * Page break logic - occurs when report line = on_pg_line
  197.    DO Pg_foot
  198.    IF _pageno >= _pepage   && Stop at ending page
  199.       GO BOTTOM
  200.       SKIP
  201.       rpt_level = 0
  202.       RETURN
  203.    ENDIF
  204.    * Print page header and column headings
  205.    DO Pg_head
  206.    DO Brk_head
  207. RETURN
  208.  
  209. PROCEDURE Pg_foot
  210.    * Print page footer
  211.    pageno = "-" + LTRIM(STR(_pageno,3,0)) + "-"
  212.    _wrap = .T.
  213.    _alignment = "CENTER"
  214.    ?
  215.    ?
  216.    ? pageno
  217.    _wrap = .F.
  218.    _alignment = "LEFT"
  219.    EJECT PAGE
  220. RETURN
  221.  
  222. PROCEDURE Pg_head
  223.    * Print page header and column headings
  224.    ?
  225.    IF _pageno <> 1
  226.       ?
  227.       ? MDY(DATE()) AT 0
  228.       ?? p_title AT (_rmargin - LEN(p_title))
  229.    ENDIF
  230.    ?
  231.    ?
  232.    DEFINE BOX FROM 0 TO 79 HEIGHT 4
  233.    ?   "Name/"           STYLE "B" AT 1
  234.    ??  "Title/"          STYLE "B" AT 30
  235.    ??  "Salary/"         STYLE "B" AT 48
  236.    ??  "Exper."          STYLE "B" AT 62
  237.    ??  "Degree"          STYLE "B" AT 73
  238.    ?   "Employee Number" STYLE "B" AT 1
  239.    ??  "Specialty"       STYLE "B" AT 30
  240.    ??  "Comm. Rate"      STYLE "B" AT 48
  241.    ?
  242. RETURN
  243.  
  244. PROCEDURE Reinit
  245.    * Re-initialize summary and calculation variables at department breaks
  246.    STORE 0 TO salary_sum, number_emp, yrsexp_sum, yrsexp_avg
  247. RETURN
  248.  
  249. PROCEDURE Rpt_end
  250.    * Print end-of-report summary data
  251.    ?
  252.    ?? "FACILITY TOTAL:" STYLE "B" AT 27
  253.    ?? "  $" AT 42
  254.    ?? salary_gt PICTURE "9,999,999.99"
  255. RETURN
  256.  
  257. PROCEDURE Title
  258.    * Print report title on page one only
  259.    ?
  260.    _wrap = .T.
  261.    _alignment = "CENTER"
  262.    ? "A-T  FURNITURE INDUSTRIES" STYLE "B"
  263.    ? "PUMPKIN CENTER FACILITY"   STYLE "BU"
  264.    ?
  265.    ? "HUMAN RESOURCES REPORT - QUARTERLY MANAGEMENT MEETING"
  266.    ?
  267.    ? MDY(DATE())
  268.    _wrap = .F.
  269.    _alignment = "LEFT"
  270. RETURN
  271. ********************************** END OF EMP_REPT.PRG **********************
  272.  
  273.