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