home *** CD-ROM | disk | FTP | other *** search
/ Liren Large Software Subsidy 5 / 05.iso / a / a031 / samples.exe / ACCT_REC.FRG < prev    next >
Encoding:
Text File  |  1992-03-10  |  6.1 KB  |  296 lines
  1. * Program............: E:acct_rec.FRG
  2. * Date...............: 3-10-92
  3. * Versions...........: dBASE IV, Report 1.5
  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
  16.  
  17. *-- Test for no records found
  18. IF EOF() .OR. .NOT. FOUND()
  19.    RETURN
  20. ENDIF
  21.  
  22. *-- turn word wrap mode off
  23. _wrap=.F.
  24.  
  25. IF _plength < (_pspacing * 4 + 1) + (_pspacing * 3 + 1) + 2
  26.    SET DEVICE TO SCREEN
  27.    DEFINE WINDOW gw_report FROM 7,17 TO 11,62 DOUBLE
  28.    ACTIVATE WINDOW gw_report
  29.    @ 0,1 SAY "Increase the page length for this report."
  30.    @ 2,1 SAY "Press any key ..."
  31.    x=INKEY(0)
  32.    DEACTIVATE WINDOW gw_report
  33.    RELEASE WINDOW gw_report
  34.    RETURN
  35. ENDIF
  36.  
  37. _plineno=0          && set lines to zero
  38. *-- NOEJECT parameter
  39. IF gl_noeject
  40.    IF _peject="BEFORE"
  41.       _peject="NONE"
  42.    ENDIF
  43.    IF _peject="BOTH"
  44.       _peject="AFTER"
  45.    ENDIF
  46. ENDIF
  47.  
  48. *-- Set-up environment
  49. ON ESCAPE DO Prnabort
  50. IF SET("TALK")="ON"
  51.    SET TALK OFF
  52.    gc_talk="ON"
  53. ELSE
  54.    gc_talk="OFF"
  55. ENDIF
  56. gc_space=SET("SPACE")
  57. SET SPACE OFF
  58. gc_time=TIME()      && system time for predefined field
  59. gd_date=DATE()      && system date  "    "    "     "
  60. gl_fandl=.F.        && first and last page flag
  61. gl_prntflg=.T.      && Continue printing flag
  62. gl_widow=.T.        && flag for checking widow bands
  63. gn_length=LEN(gc_heading)  && store length of the HEADING
  64. gn_level=2          && current band being processed
  65. gn_page=_pageno     && grab current page number
  66. gn_pspace=_pspacing && get current print spacing
  67.  
  68.  
  69. *-- Set up procedure for page break
  70. gn_atline=_plength - (_pspacing * 3 + 1)
  71. ON PAGE AT LINE gn_atline EJECT PAGE
  72.  
  73. *-- Print Report
  74.  
  75. PRINTJOB
  76.  
  77. *-- Initialize summary variables.
  78. r_msum1=0
  79. r_msum2=0
  80.  
  81. IF gl_plain
  82.    ON PAGE AT LINE gn_atline DO Pgplain
  83. ELSE
  84.    ON PAGE AT LINE gn_atline DO Pgfoot
  85. ENDIF
  86.  
  87. DO Pghead
  88.  
  89. gl_fandl=.T.        && first physical page started
  90.  
  91. DO Rintro
  92.  
  93. *-- File Loop
  94. DO WHILE FOUND() .AND. .NOT. EOF() .AND. gl_prntflg
  95.    gn_level=0
  96.    *-- Detail lines
  97.    IF gl_summary
  98.       DO Upd_Vars
  99.    ELSE
  100.       DO __Detail
  101.    ENDIF
  102.    gl_widow=.T.         && enable widow checking
  103.    CONTINUE
  104. ENDDO
  105.  
  106. IF gl_prntflg
  107.    DO Rsumm
  108.    IF _plineno <= gn_atline
  109.       EJECT PAGE
  110.    ENDIF
  111. ELSE
  112.    DO Rsumm
  113.    DO Reset
  114.    RETURN
  115. ENDIF
  116.  
  117. ON PAGE
  118.  
  119. ENDPRINTJOB
  120.  
  121. DO Reset
  122. RETURN
  123. * EOP: E:acct_rec.FRG
  124.  
  125. *-- Update summary fields and/or calculated fields.
  126. PROCEDURE Upd_Vars
  127. *-- Sum
  128. r_msum1=r_msum1+OLDBALANCE
  129. *-- Sum
  130. r_msum2=r_msum2+AMT_OF_BIL
  131. RETURN
  132. * EOP: Upd_Vars
  133.  
  134. *-- Set flag to get out of DO WHILE loop when escape is pressed.
  135. PROCEDURE Prnabort
  136. gl_prntflg=.F.
  137. RETURN
  138. * EOP: Prnabort
  139.  
  140. PROCEDURE Pghead
  141. PRIVATE ll_heading, ln_width
  142. ll_heading = .T.
  143. ln_width = _rmargin - _lmargin
  144. ?
  145. *-- Print HEADING parameter - if it doesn't fit on line one
  146. *-- Value added to gn_length is the last column on line one times two
  147. IF .NOT. gl_plain .AND. gn_length + 160 > ln_width
  148.    ?? gc_heading FUNCTION "I;V"+LTRIM(STR(ln_width))
  149.    ?
  150.    ll_heading = .F.
  151. ENDIF
  152.  
  153. ?? IIF(gl_plain,'',gd_date) AT 0,;
  154.  IIF(gl_plain,'' , "PAGE  " ) AT 70,;
  155.  IIF(gl_plain,'',_pageno) PICTURE "999" 
  156.  
  157. *-- Print HEADING parameter - if it fits on line one
  158. IF .NOT. gl_plain .AND. gn_length > 0 .AND. ll_heading
  159.    ?? " "
  160.    ?? gc_heading FUNCTION "I;V"+LTRIM(STR(ln_width-(_pcolno*2)))
  161. ENDIF
  162. ?
  163. ?
  164. ?
  165. RETURN
  166. * EOP: Pghead
  167.  
  168. PROCEDURE Rintro
  169. ?
  170. DEFINE BOX FROM 24 TO 57 HEIGHT 4 DOUBLE
  171. ?
  172. ?? "A-T FURNITURE INDUSTRIES" STYLE "B" AT 29
  173. ?
  174. ?? "ACCOUNTS RECEIVABLE REPORT" STYLE "B" AT 28
  175. ?
  176. ?
  177. ?
  178. RETURN
  179. * EOP: Rintro
  180.  
  181. PROCEDURE __Detail
  182. IF 12 * gn_pspace < gn_atline - (_pspacing * 4 + 1)
  183.    IF gl_widow .AND. _plineno+12 * gn_pspace > gn_atline + 1
  184.       EJECT PAGE
  185.    ENDIF
  186. ENDIF
  187. DO Upd_Vars
  188. ?? ;
  189. "──────────────────────────────────────────────────────────────────────";
  190. + "─────────";
  191. AT 0
  192. ?
  193. ?? "INVOICE NUMBER: " STYLE "B" AT 0,;
  194.  Invoice_no FUNCTION "T" STYLE "B" ,;
  195.  "DATE: " STYLE "B" AT 65,;
  196.  Dat_of_bil STYLE "B" 
  197. ?
  198. ?? "CUSTOMER ID: " AT 0,;
  199.  Cust_id FUNCTION "T" 
  200. ?
  201. ?? "PREVIOUS INVOICE #: " AT 6,;
  202.  Invoic_old FUNCTION "T" ,;
  203.  "SENT: " AT 40,;
  204.  Dat_lstbil 
  205. ?
  206. ?? "PREVIOUS INVOICE: $ " AT 6,;
  207.  Amt_lstbil PICTURE "999,999.99" 
  208. ?
  209. ?? "AMOUNT PAID:        " AT 6,;
  210.  Amt_lst_pd PICTURE "999,999.99" 
  211. ?
  212. ?? "----------" AT 26
  213. ?
  214. ?? "PREVIOUS BALANCE: $ " AT 6,;
  215.  Oldbalance PICTURE "999,999.99" 
  216. ?
  217. ?? "CURRENT ORDERS:     " AT 6,;
  218.  Amt_of_cur PICTURE "999,999.99" ,;
  219.  "COMMENTS: " AT 40,;
  220.  Comments FUNCTION "T" 
  221. ?
  222. ?? "==========" AT 26
  223. ?
  224. ?? "CURRENT INVOICE:  $ " AT 6,;
  225.  Amt_of_bil PICTURE "999,999.99" ,;
  226.  "NOTES: " AT 40,;
  227.  Notes FUNCTION "T" 
  228. ?
  229. ?
  230. RETURN
  231. * EOP: __Detail
  232.  
  233. PROCEDURE Rsumm
  234. ?
  235. ?? ;
  236. "══════════════════════════════════════════════════════════════════════";
  237. + "═════════";
  238. AT 0
  239. ?
  240. ?? "TOTAL AMOUNT OF PREVIOUS BALANCES:  $ " AT 0,;
  241.  r_msum1 PICTURE "999,9999.99" 
  242. ?
  243. ?? "TOTAL AMOUNT OF CURRENT INVOICES:   $ " AT 0,;
  244.  r_msum2 PICTURE "999,9999.99" 
  245. ?
  246. ?? ;
  247. "══════════════════════════════════════════════════════════════════════";
  248. + "═════════";
  249. AT 0
  250. gl_fandl=.F.        && last page finished
  251. ?
  252. RETURN
  253. * EOP: Rsumm
  254.  
  255. PROCEDURE Pgfoot
  256. PRIVATE _box, _pspacing
  257. gl_widow=.F.         && disable widow checking
  258. _pspacing=1
  259. ?
  260. IF .NOT. gl_plain
  261.    _pspacing=gn_pspace
  262.    ?
  263.    ?? "PREPARED BY FINANCIAL DEPARTMENT" AT 26
  264.    ?
  265. ENDIF
  266. EJECT PAGE
  267. *-- is the page number greater than the ending page
  268. IF _pageno > _pepage
  269.    GOTO BOTTOM
  270.    SKIP
  271.    gn_level=0
  272. ENDIF
  273. IF .NOT. gl_plain .AND. gl_fandl
  274.    _pspacing=gn_pspace
  275.    DO Pghead
  276. ENDIF
  277. RETURN
  278. * EOP: Pgfoot
  279.  
  280. *-- Process page break when PLAIN option is used.
  281. PROCEDURE Pgplain
  282. PRIVATE _box
  283. EJECT PAGE
  284. RETURN
  285. * EOP: Pgplain
  286.  
  287. *-- Reset dBASE environment prior to calling report
  288. PROCEDURE Reset
  289. SET SPACE &gc_space.
  290. SET TALK &gc_talk.
  291. ON ESCAPE
  292. ON PAGE
  293. RETURN
  294. * EOP: Reset
  295.  
  296.