home *** CD-ROM | disk | FTP | other *** search
/ DOS Wares / doswares.zip / doswares / DATABASE / DBASE5 / SAMPLES.ZIP / CUST.FRG < prev    next >
Encoding:
Text File  |  1994-06-24  |  7.2 KB  |  370 lines
  1. * Program............: cust.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.  
  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=CATEGORY
  84.  
  85. *-- Initialize summary variables.
  86. cust_cnt=0
  87. r_msum1=0
  88.  
  89. IF gl_plain
  90.    ON PAGE AT LINE gn_atline DO Pgplain
  91. ELSE
  92.    ON PAGE AT LINE gn_atline DO Pgfoot
  93. ENDIF
  94.  
  95. DO Pghead
  96.  
  97. gl_fandl=.T.        && first physical page started
  98.  
  99. DO Rintro
  100.  
  101. DO Grphead
  102.  
  103. *-- File Loop
  104. DO WHILE FOUND() .AND. .NOT. EOF() .AND. gl_prntflg
  105.    DO CASE
  106.    CASE CATEGORY <> r_mvar4
  107.       gn_level=4
  108.    OTHERWISE
  109.       gn_level=0
  110.    ENDCASE
  111.    *-- test whether an expression didn't match
  112.    IF gn_level <> 0
  113.       DO Grpfoot WITH 100-gn_level
  114.       DO Grpinit
  115.    ENDIF
  116.    *-- Repeat group intros
  117.    IF gn_level <> 0
  118.       DO Grphead
  119.    ENDIF
  120.    gn_level=0
  121.    *-- Detail lines
  122.    IF gl_summary
  123.       DO Upd_Vars
  124.    ELSE
  125.       DO __Detail
  126.    ENDIF
  127.    gl_widow=.T.         && enable widow checking
  128.    CONTINUE
  129. ENDDO
  130.  
  131. IF gl_prntflg
  132.    gn_level=3
  133.    DO Grpfoot WITH 97
  134.    DO Rsumm
  135.    IF _plineno <= gn_atline
  136.       EJECT PAGE
  137.    ENDIF
  138. ELSE
  139.    gn_level=3
  140.    DO Rsumm
  141.    DO Reset
  142.    RETURN
  143. ENDIF
  144.  
  145. ON PAGE
  146.  
  147. ENDPRINTJOB
  148.  
  149. DO Reset
  150. RETURN
  151. * EOP: cust.FRG
  152.  
  153. *-- Determine height of group bands and detail band for widow checking
  154. FUNCTION Gheight
  155. PARAMETER Group_Band
  156. retval=0              && return value
  157. IF Group_Band <= 4
  158.    retval = retval + 2 * gn_pspace
  159. ENDIF
  160. *-- add height of detail band
  161. retval = retval + 8 * gn_pspace
  162. RETURN retval
  163. * EOP: Gheight
  164.  
  165. *-- Update summary fields and/or calculated fields.
  166. PROCEDURE Upd_Vars
  167. r_foot1=Category
  168. *-- Count
  169. cust_cnt=cust_cnt+1
  170. *-- Count
  171. r_msum1=r_msum1+1
  172. RETURN
  173. * EOP: Upd_Vars
  174.  
  175. *-- Set flag to get out of DO WHILE loop when escape is pressed.
  176. PROCEDURE Prnabort
  177. gl_prntflg=.F.
  178. RETURN
  179. * EOP: Prnabort
  180.  
  181. *-- Reset group break variables.  Reinit summary
  182. *-- fields with reset set to a particular group band.
  183. PROCEDURE Grpinit
  184. IF gn_level <= 4
  185.    cust_cnt=0
  186. ENDIF
  187. IF gn_level <= 4
  188.    r_mvar4=CATEGORY
  189. ENDIF
  190. RETURN
  191. * EOP: Grpinit
  192.  
  193. *-- Process Group Intro bands during group breaks
  194. PROCEDURE Grphead
  195. IF EOF()
  196.    RETURN
  197. ENDIF
  198. PRIVATE _pspacing
  199. _pspacing=gn_pspace
  200. IF gn_level = 0
  201.    gn_level=50
  202. ENDIF
  203. IF gn_level = 4
  204.    IF 2 * gn_pspace  < gn_atline
  205.       IF (gl_widow .AND. _plineno+Gheight(4) > gn_atline + 1) ;
  206.       .OR. (gl_widow .AND. _plineno+2 * gn_pspace > gn_atline)
  207.          EJECT PAGE
  208.       ENDIF
  209.    ENDIF
  210. ENDIF
  211. IF gn_level <= 4
  212.    DO Head4
  213. ENDIF
  214. gn_level=0
  215. RETURN
  216. * EOP: Grphead.PRG
  217.  
  218. *-- Process Group Summary bands during group breaks
  219. PROCEDURE Grpfoot
  220. PARAMETER ln_level
  221. IF ln_level >= 96
  222.    DO Foot96
  223. ENDIF
  224. RETURN
  225. * EOP: Grpfoot.PRG
  226.  
  227. PROCEDURE Pghead
  228. ?? IIF(gl_plain,'',gd_date) AT 0,;
  229.  IIF(gl_plain,'' , "PAGE " ) AT 71,;
  230.  IIF(gl_plain,'',_pageno) PICTURE "999" 
  231. ?
  232. ?
  233. ?
  234. RETURN
  235. * EOP: Pghead
  236.  
  237. PROCEDURE Rintro
  238. ?
  239. DEFINE BOX FROM 26 TO 55 HEIGHT 4 DOUBLE
  240. ?
  241. ?? "A-T FURNITURE INDUSTRIES" STYLE "B" AT 29
  242. ?
  243. ?? "CUSTOMER REPORT" STYLE "B" AT 33
  244. ?
  245. ?
  246. ?
  247. ?
  248. RETURN
  249. * EOP: Rintro
  250.  
  251. PROCEDURE Head4
  252. IF gn_level=1
  253.    RETURN
  254. ENDIF
  255. ?? ;
  256. "══════════════════════════════════════════════════════════════════════";
  257. + "═════════";
  258. AT 0
  259. ?
  260. ?? "CATEGORY:" STYLE "BU" AT 0,;
  261.  Category FUNCTION "T" STYLE "BU" AT 10
  262. ?
  263. RETURN
  264.  
  265. PROCEDURE __Detail
  266. IF 8 * gn_pspace < gn_atline - (_pspacing * 3 + 1)
  267.    IF gl_widow .AND. _plineno+8 * gn_pspace > gn_atline + 1
  268.       EJECT PAGE
  269.    ENDIF
  270. ENDIF
  271. DO Upd_Vars
  272. ?? "I.D.: " AT 0,;
  273.  Cust_id FUNCTION "T" PICTURE "!XXXXX" 
  274. ?
  275. ?? Customer FUNCTION "T" AT 0,;
  276.  Phone FUNCTION "T" PICTURE "(XXX)XXX-XXXX" AT 46
  277. ?
  278. ?? Address1 FUNCTION "T" AT 0,;
  279.  " " ,;
  280.  Address2 FUNCTION "T" 
  281. ?
  282. ?? City FUNCTION "T" AT 0,;
  283.  ", " ,;
  284.  State FUNCTION "T" ,;
  285.  " " ,;
  286.  Zip FUNCTION "T" 
  287. ?
  288. ?? "CONTACT:" AT 0,;
  289.  Contact FUNCTION "T" AT 9,;
  290.  Phone_cont FUNCTION "T" PICTURE "(XXX)XXX-XXXX" AT 46,;
  291.  "EXT." AT 62,;
  292.  Phone_ext FUNCTION "T" AT 67
  293. ?
  294. ?? "DATE OF LAST CONTACT: " AT 0,;
  295.  Date_last 
  296. ?
  297. ?? Comments FUNCTION "T" AT 0
  298. ?
  299. ?
  300. RETURN
  301. * EOP: __Detail
  302.  
  303. PROCEDURE Foot96
  304. ?? "NUMBER OF CUSTOMERS IN " AT 0,;
  305.  r_foot1 FUNCTION "T" ,;
  306.  ": " ,;
  307.  cust_cnt PICTURE "9999" 
  308. ?
  309. ?
  310. RETURN
  311.  
  312. PROCEDURE Rsumm
  313. ?
  314. ?? ;
  315. "══════════════════════════════════════════════════════════════════════";
  316. + "═════════";
  317. AT 0
  318. ?
  319. ?? "TOTAL NUMBER OF CUSTOMERS: " AT 0,;
  320.  r_msum1 PICTURE "9999" 
  321. ?
  322. ?? ;
  323. "══════════════════════════════════════════════════════════════════════";
  324. + "═════════";
  325. AT 0
  326. gl_fandl=.F.        && last page finished
  327. ?
  328. RETURN
  329. * EOP: Rsumm
  330.  
  331. PROCEDURE Pgfoot
  332. PRIVATE _box, _pspacing
  333. gl_widow=.F.         && disable widow checking
  334. _pspacing=1
  335. ?
  336. IF .NOT. gl_plain
  337.    _pspacing=gn_pspace
  338.    ?? " PREPARED BY SALES DEPARTMENT" AT 25
  339. ENDIF
  340. EJECT PAGE
  341. *-- is the page number greater than the ending page
  342. IF _pageno > _pepage
  343.    GOTO BOTTOM
  344.    SKIP
  345.    gn_level=0
  346. ENDIF
  347. IF .NOT. gl_plain .AND. gl_fandl
  348.    _pspacing=gn_pspace
  349.    DO Pghead
  350. ENDIF
  351. RETURN
  352. * EOP: Pgfoot
  353.  
  354. *-- Process page break when PLAIN option is used.
  355. PROCEDURE Pgplain
  356. PRIVATE _box
  357. EJECT PAGE
  358. RETURN
  359. * EOP: Pgplain
  360.  
  361. *-- Reset dBASE environment prior to calling report
  362. PROCEDURE Reset
  363. SET SPACE &gc_space.
  364. SET TALK &gc_talk.
  365. ON ESCAPE
  366. ON PAGE
  367. RETURN
  368. * EOP: Reset
  369.  
  370.