home *** CD-ROM | disk | FTP | other *** search
/ DOS Wares / doswares.zip / doswares / DATABASE / DBASE5 / SAMPLES.ZIP / GOODS.FRG < prev    next >
Encoding:
Text File  |  1994-06-24  |  8.1 KB  |  405 lines
  1. * Program............: goods.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. *-- Initialize group footer field variables
  71. r_foot1=.F.
  72.  
  73. *-- Initialize calculated variables.
  74. inv_cost=0
  75.  
  76. *-- Set up procedure for page break
  77. gn_atline=_plength - (_pspacing + 1)
  78. ON PAGE AT LINE gn_atline EJECT PAGE
  79.  
  80. *-- Print Report
  81.  
  82. PRINTJOB
  83.  
  84. *-- Initialize group break vars.
  85. r_mvar4=VENDOR_ID
  86.  
  87. *-- Initialize summary variables.
  88. r_msum1=0
  89. r_msum2=0
  90.  
  91. *-- Assign initial values to calculated variables.
  92. inv_cost=QTY_ONHAND*COST
  93.  
  94. IF gl_plain
  95.    ON PAGE AT LINE gn_atline DO Pgplain
  96. ELSE
  97.    ON PAGE AT LINE gn_atline DO Pgfoot
  98. ENDIF
  99.  
  100. DO Pghead
  101.  
  102. gl_fandl=.T.        && first physical page started
  103.  
  104. DO Rintro
  105.  
  106. DO Grphead
  107.  
  108. *-- File Loop
  109. DO WHILE FOUND() .AND. .NOT. EOF() .AND. gl_prntflg
  110.    DO CASE
  111.    CASE VENDOR_ID <> r_mvar4
  112.       gn_level=4
  113.    OTHERWISE
  114.       gn_level=0
  115.    ENDCASE
  116.    *-- test whether an expression didn't match
  117.    IF gn_level <> 0
  118.       DO Grpfoot WITH 100-gn_level
  119.       DO Grpinit
  120.    ENDIF
  121.    *-- Repeat group intros
  122.    IF gn_level <> 0
  123.       DO Grphead
  124.    ENDIF
  125.    gn_level=0
  126.    *-- Detail lines
  127.    IF gl_summary
  128.       DO Upd_Vars
  129.    ELSE
  130.       DO __Detail
  131.    ENDIF
  132.    gl_widow=.T.         && enable widow checking
  133.    CONTINUE
  134. ENDDO
  135.  
  136. IF gl_prntflg
  137.    gn_level=3
  138.    DO Grpfoot WITH 97
  139.    DO Rsumm
  140.    IF _plineno <= gn_atline
  141.       EJECT PAGE
  142.    ENDIF
  143. ELSE
  144.    gn_level=3
  145.    DO Rsumm
  146.    DO Reset
  147.    RETURN
  148. ENDIF
  149.  
  150. ON PAGE
  151.  
  152. ENDPRINTJOB
  153.  
  154. DO Reset
  155. RETURN
  156. * EOP: goods.FRG
  157.  
  158. *-- Determine height of group bands and detail band for widow checking
  159. FUNCTION Gheight
  160. PARAMETER Group_Band
  161. retval=0              && return value
  162. IF Group_Band <= 4
  163.    retval = retval + 2 * gn_pspace
  164. ENDIF
  165. *-- add height of detail band
  166. retval = retval + 10 * gn_pspace
  167. RETURN retval
  168. * EOP: Gheight
  169.  
  170. *-- Update summary fields and/or calculated fields.
  171. PROCEDURE Upd_Vars
  172. inv_cost=QTY_ONHAND*COST
  173. r_foot1=Vendor_id
  174. *-- Sum
  175. r_msum1=r_msum1+INV_COST
  176. *-- Sum
  177. r_msum2=r_msum2+INV_COST
  178. RETURN
  179. * EOP: Upd_Vars
  180.  
  181. *-- Set flag to get out of DO WHILE loop when escape is pressed.
  182. PROCEDURE Prnabort
  183. gl_prntflg=.F.
  184. RETURN
  185. * EOP: Prnabort
  186.  
  187. *-- Reset group break variables.  Reinit summary
  188. *-- fields with reset set to a particular group band.
  189. PROCEDURE Grpinit
  190. IF gn_level <= 4
  191.    r_msum1=0
  192. ENDIF
  193. IF gn_level <= 4
  194.    r_mvar4=VENDOR_ID
  195. ENDIF
  196. RETURN
  197. * EOP: Grpinit
  198.  
  199. *-- Process Group Intro bands during group breaks
  200. PROCEDURE Grphead
  201. IF EOF()
  202.    RETURN
  203. ENDIF
  204. PRIVATE _pspacing
  205. _pspacing=gn_pspace
  206. IF gn_level = 0
  207.    gn_level=50
  208. ENDIF
  209. IF gn_level = 4
  210.    IF 2 * gn_pspace  < gn_atline
  211.       IF (gl_widow .AND. _plineno+Gheight(4) > gn_atline + 1) ;
  212.       .OR. (gl_widow .AND. _plineno+2 * gn_pspace > gn_atline)
  213.          EJECT PAGE
  214.       ENDIF
  215.    ENDIF
  216. ENDIF
  217. IF gn_level <= 4
  218.    DO Head4
  219. ENDIF
  220. gn_level=0
  221. RETURN
  222. * EOP: Grphead.PRG
  223.  
  224. *-- Process Group Summary bands during group breaks
  225. PROCEDURE Grpfoot
  226. PARAMETER ln_level
  227. IF ln_level >= 96
  228.    DO Foot96
  229. ENDIF
  230. RETURN
  231. * EOP: Grpfoot.PRG
  232.  
  233. PROCEDURE Pghead
  234. PRIVATE ll_heading, ln_width
  235. ll_heading = .T.
  236. ln_width = _rmargin - _lmargin
  237. ?
  238. *-- Print HEADING parameter - if it doesn't fit on line one
  239. *-- Value added to gn_length is the last column on line one times two
  240. IF .NOT. gl_plain .AND. gn_length + 160 > ln_width
  241.    ?? gc_heading FUNCTION "I;V"+LTRIM(STR(ln_width))
  242.    ?
  243.    ll_heading = .F.
  244. ENDIF
  245.  
  246. ?? IIF(gl_plain,'',gd_date) AT 0,;
  247.  IIF(gl_plain,'' , "PAGE  " ) AT 70,;
  248.  IIF(gl_plain,'',_pageno) PICTURE "999" 
  249.  
  250. *-- Print HEADING parameter - if it fits on line one
  251. IF .NOT. gl_plain .AND. gn_length > 0 .AND. ll_heading
  252.    ?? " "
  253.    ?? gc_heading FUNCTION "I;V"+LTRIM(STR(ln_width-(_pcolno*2)))
  254. ENDIF
  255. ?
  256. ?
  257. RETURN
  258. * EOP: Pghead
  259.  
  260. PROCEDURE Rintro
  261. ?
  262. DEFINE BOX FROM 27 TO 56 HEIGHT 4 DOUBLE
  263. ?
  264. ?? "A-T FURNITURE INDUSTRIES" AT 30
  265. ?
  266. ?? "INVENTORY REPORT" AT 34
  267. ?
  268. ?
  269. ?
  270. ?
  271. RETURN
  272. * EOP: Rintro
  273.  
  274. PROCEDURE Head4
  275. IF gn_level=1
  276.    RETURN
  277. ENDIF
  278. ?? ;
  279. "══════════════════════════════════════════════════════════════════════";
  280. + "═════════";
  281. AT 0
  282. ?
  283. ?? "VENDOR ID: " STYLE "BU" AT 0,;
  284.  Vendor_id FUNCTION "T" STYLE "BU" 
  285. ?
  286. RETURN
  287.  
  288. PROCEDURE __Detail
  289. IF 10 * gn_pspace < gn_atline - (_pspacing * 3 + 1)
  290.    IF gl_widow .AND. _plineno+10 * gn_pspace > gn_atline + 1
  291.       EJECT PAGE
  292.    ENDIF
  293. ENDIF
  294. DO Upd_Vars
  295. ?? ;
  296. "──────────────────────────────────────────────────────────────────────";
  297. + "─────────";
  298. AT 0
  299. ?
  300. ?? "PART I.D.: " AT 3,;
  301.  Part_id FUNCTION "T" ,;
  302.  "NAME: " AT 27,;
  303.  Part_name FUNCTION "T" AT 40
  304. ?
  305. ?? "DESCRIPTION: " AT 27,;
  306.  Descript FUNCTION "T" 
  307. ?
  308. ?? "QUANTITY ON HAND:   " AT 27,;
  309.  Qty_onhand PICTURE "9,999" ,;
  310.  "SALES PRICE: $ " AT 55,;
  311.  Price PICTURE "99,999.99" 
  312. ?
  313. ?? "COST: $ " AT 27,;
  314.  "  " AT 41,;
  315.  Cost PICTURE "99,999.99" ,;
  316.  "ORDER QTY(min):    " AT 55,;
  317.  Qty_2order PICTURE "9,999" 
  318. ?
  319. ?? " ==========" AT 41,;
  320.  "DATE ORDERED:   " AT 55,;
  321.  Date_order 
  322. ?
  323. ?? "INVENT. COST:$" AT 27,;
  324.  inv_cost PICTURE "999,999.99" AT 42,;
  325.  "DISCONTINUED: " AT 55,;
  326.  Discontinu PICTURE "Y" 
  327. ?
  328. ?? "COMMENTS: " AT 27,;
  329.  Comments FUNCTION "T" 
  330. ?
  331. ?
  332. ?
  333. RETURN
  334. * EOP: __Detail
  335.  
  336. PROCEDURE Foot96
  337. ?
  338. ?? "INVENTORY COST FOR VENDOR " AT 0,;
  339.  r_foot1 FUNCTION "T" ,;
  340.  ": $ " ,;
  341.  r_msum1 PICTURE "999,999.99" ,;
  342.  " " 
  343. ?
  344. RETURN
  345.  
  346. PROCEDURE Rsumm
  347. ?
  348. ?? ;
  349. "══════════════════════════════════════════════════════════════════════";
  350. + "═════════";
  351. AT 0
  352. ?
  353. ?? "TOTAL INVENTORY COST: " AT 0,;
  354.  "$ " AT 32,;
  355.  r_msum2 PICTURE "999,999.99" 
  356. ?
  357. ?? ;
  358. "══════════════════════════════════════════════════════════════════════";
  359. + "═════════";
  360. AT 0
  361. gl_fandl=.F.        && last page finished
  362. ?
  363. RETURN
  364. * EOP: Rsumm
  365.  
  366. PROCEDURE Pgfoot
  367. PRIVATE _box, _pspacing
  368. gl_widow=.F.         && disable widow checking
  369. _pspacing=1
  370. ?
  371. IF .NOT. gl_plain
  372.    _pspacing=gn_pspace
  373.    ?? "REPORT PREPARED BY FINANCIAL DEPARTMENT" AT 24
  374. ENDIF
  375. EJECT PAGE
  376. *-- is the page number greater than the ending page
  377. IF _pageno > _pepage
  378.    GOTO BOTTOM
  379.    SKIP
  380.    gn_level=0
  381. ENDIF
  382. IF .NOT. gl_plain .AND. gl_fandl
  383.    _pspacing=gn_pspace
  384.    DO Pghead
  385. ENDIF
  386. RETURN
  387. * EOP: Pgfoot
  388.  
  389. *-- Process page break when PLAIN option is used.
  390. PROCEDURE Pgplain
  391. PRIVATE _box
  392. EJECT PAGE
  393. RETURN
  394. * EOP: Pgplain
  395.  
  396. *-- Reset dBASE environment prior to calling report
  397. PROCEDURE Reset
  398. SET SPACE &gc_space.
  399. SET TALK &gc_talk.
  400. ON ESCAPE
  401. ON PAGE
  402. RETURN
  403. * EOP: Reset
  404.  
  405.