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