home *** CD-ROM | disk | FTP | other *** search
/ DOS Wares / doswares.zip / doswares / DATABASE / DBASE4NL / SAMPLES.ZIP / KLNT.FRG < prev    next >
Encoding:
Text File  |  1993-05-18  |  7.3 KB  |  366 lines
  1. * Programma..........:  KLNT.FRG
  2. * Datum..............:  22-04-93
  3. * Versies............: dBASE IV
  4. *
  5. * Notities:
  6. * ------
  7. * Voordat u deze procedure met het DO-commando gaat uitvoeren
  8. * moet u LOCATE gebruiken, omdat de CONTINUE-
  9. * opdracht zich in de hoofdlus bevindt.
  10. *
  11. *-- Parameters
  12. PARAMETERS gl_noeject, gl_plain, gl_summary, gc_heading, gc_extra
  13. ** De eerste drie parameters zijn van het type Logisch.
  14. ** De vierde parameter is een tekenreeks en de vijfde is een extra parameter.
  15. PRIVATE _peject, _wrap, ll_heading
  16. ll_heading=.F.
  17.  
  18. *-- Testen op de aanwezigheid van records
  19. IF EOF() .OR. .NOT. FOUND()
  20.    RETURN
  21. ENDIF
  22.  
  23. *-- regelovergang uitschakelen
  24. _wrap=.F.
  25.  
  26. IF _plength < (_pspacing * 3 + 1) + (_pspacing + 1) + 2
  27.    SET DEVICE TO SCREEN
  28.    DEFINE WINDOW gw_report FROM 7,17 TO 11,62 DOUBLE
  29.    ACTIVATE WINDOW gw_report
  30.    @ 0,1 SAY "Verhoog de paginalengte voor dit rapport."
  31.    @ 2,1 SAY "Druk op een toets ..."
  32.    x=INKEY(0)
  33.    DEACTIVATE WINDOW gw_report
  34.    RELEASE WINDOW gw_report
  35.    RETURN
  36. ENDIF
  37.  
  38. _plineno=0          && regels instellen op nul
  39. *-- NOEJECT-parameter
  40. IF gl_noeject
  41.    IF _peject="BEFORE"
  42.       _peject="NONE"
  43.    ENDIF
  44.    IF _peject="BOTH"
  45.       _peject="AFTER"
  46.    ENDIF
  47. ENDIF
  48.  
  49. *-- Instellingsomgeving
  50. ON ESCAPE DO Prnabort
  51. IF SET("TALK")="ON"
  52.    SET TALK OFF
  53.    gc_talk="ON"
  54. ELSE
  55.    gc_talk="OFF"
  56. ENDIF
  57. gc_space=SET("SPACE")
  58. SET SPACE OFF
  59. gc_time=TIME()      && systeemtijd opgegeven veld
  60. gd_date=DATE()      &&&& systeemdatum  "    "    "     "
  61. gl_fandl=.F.        && vlag voor eerste en laatste pagina
  62. gl_prntflg=.T.      &&Doorgaan met het afdrukken van vlag
  63. gl_widow=.T.        &&vlag voor het controleren van weduwezones
  64. gn_length=LEN(gc_heading)  && lengte van kopregel opslaan
  65. gn_level=2          &&verwerking van actieve zone
  66. gn_page=_pageno     &&nummer van actieve pagina vastleggen
  67. gn_pspace=_pspacing &&actieve regelafstand voor afdruk bepalen
  68.  
  69. *-- Initiatie van variabelen voor voetregelvelden van groep
  70. r_foot1=.F.
  71.  
  72.  
  73. *-- Instellen van pagina-onderbrekingen
  74. gn_atline=_plength - (_pspacing + 1)
  75. ON PAGE AT LINE gn_atline EJECT PAGE
  76.  
  77. *-- Afdrukken rapport
  78.  
  79. PRINTJOB
  80.  
  81. *-- Initiatie van variabelen voor groeponderbreking.
  82. r_mvar4=CATEGORIE
  83.  
  84. *-- Initiatie van samenvattingsvelden.
  85. r_msum1=0
  86. r_msum2=0
  87.  
  88. IF gl_plain
  89.    ON PAGE AT LINE gn_atline DO Pgplain
  90. ELSE
  91.    ON PAGE AT LINE gn_atline DO Pgfoot
  92. ENDIF
  93.  
  94. DO Pghead
  95.  
  96. gl_fandl=.T.        && eerste pagina gestart
  97.  
  98. DO Rintro
  99.  
  100. DO Grphead
  101.  
  102. *-- Bestandslus
  103. DO WHILE FOUND() .AND. .NOT. EOF() .AND. gl_prntflg
  104.    DO CASE
  105.    CASE CATEGORIE <> r_mvar4
  106.       gn_level=4
  107.    OTHERWISE
  108.       gn_level=0
  109.    ENDCASE
  110.    *controleren of uitdrukking niet aan voorwaarden voldeed
  111.    IF gn_level <> 0
  112.       DO Grpfoot WITH 100-gn_level
  113.       DO Grpinit
  114.    ENDIF
  115.    *-- Herhalen groepaanheffen
  116.    IF gn_level <> 0
  117.       DO Grphead
  118.    ENDIF
  119.    gn_level=0
  120.    *-- Detailregels
  121.    IF gl_summary
  122.       DO Upd_Vars
  123.    ELSE
  124.       DO __Detail
  125.    ENDIF
  126.    gl_widow=.T.         && weduwecontrole inschakelen
  127.    CONTINUE
  128. ENDDO
  129.  
  130. IF gl_prntflg
  131.    gn_level=3
  132.    DO Grpfoot WITH 97
  133.    DO Rsumm
  134.    IF _plineno <= gn_atline
  135.       EJECT PAGE
  136.    ENDIF
  137. ELSE
  138.    gn_level=3
  139.    DO Rsumm
  140.    DO Reset
  141.    RETURN
  142. ENDIF
  143.  
  144. ON PAGE
  145.  
  146. ENDPRINTJOB
  147.  
  148. DO Reset
  149. RETURN
  150. * EOP: C:\NL_15\DATA\KLNT.FRG
  151.  
  152. *Hoogte van groepaanheffen en detailzone voor de weduwecontrole bepalen
  153. FUNCTION Gheight
  154. PARAMETER Group_Band
  155. retval=0              &&resulterende waarde
  156. IF Group_Band <= 4
  157.    retval = retval + 2 * gn_pspace
  158. ENDIF
  159. *hoogte van detailzone erbij optellen
  160. retval = retval + 8 * gn_pspace
  161. RETURN retval
  162. * EOP: Gheight
  163.  
  164. *Bijwerken van samenvattingsvelden en/of rekenvelden.
  165. PROCEDURE Upd_Vars
  166. r_foot1=Categorie
  167. *telling
  168. r_msum1=r_msum1+1
  169. *telling
  170. r_msum2=r_msum2+1
  171. RETURN
  172. * EOP: Upd_Vars
  173.  
  174. *-- Vlag instellen zodat met ESC de DO WHILE-lus wordt verlaten
  175. PROCEDURE Prnabort
  176. gl_prntflg=.F.
  177. RETURN
  178. * EOP: Prnabort
  179.  
  180. *Variabelen voor groeponderbreking weer instellen/initiatie van samenvatting
  181. *-- velden met nieuwe instellingen voor een bepaalde groepzone
  182. PROCEDURE Grpinit
  183. IF gn_level <= 4
  184.    r_mvar4=CATEGORIE
  185. ENDIF
  186. RETURN
  187. * EOP: Grpinit
  188.  
  189. *-- Verwerking van aanhefzones tijdens groeponderbrekingen
  190. PROCEDURE Grphead
  191. IF EOF()
  192.    RETURN
  193. ENDIF
  194. PRIVATE _pspacing
  195. _pspacing=gn_pspace
  196. IF gn_level = 0
  197.    gn_level=50
  198. ENDIF
  199. IF gn_level = 4
  200.    IF 2 * gn_pspace  < gn_atline
  201.       IF (gl_widow .AND. _plineno+Gheight(4) > gn_atline + 1) ;
  202.       .OR. (gl_widow .AND. _plineno+2 * gn_pspace > gn_atline)
  203.          EJECT PAGE
  204.       ENDIF
  205.    ENDIF
  206. ENDIF
  207. IF gn_level <= 4
  208.    DO Head4
  209. ENDIF
  210. gn_level=0
  211. RETURN
  212. * EOP: Grphead.PRG
  213.  
  214. *-- Verwerking van samenvattingszones tijdens groeponderbrekingen
  215. PROCEDURE Grpfoot
  216. PARAMETER ln_level
  217. IF ln_level >= 96
  218.    DO Foot96
  219. ENDIF
  220. RETURN
  221. * EOP: Grpfoot.PRG
  222.  
  223. PROCEDURE Pghead
  224. ?? IIF(gl_plain,'',gd_date) AT 0,;
  225.  "Pag. " AT 71,;
  226.  IIF(gl_plain,'',_pageno) PICTURE "999" 
  227. ?
  228. ?
  229. ?
  230. RETURN
  231. * EOP: Pghead
  232.  
  233. PROCEDURE Rintro
  234. ?
  235. DEFINE BOX FROM 27 TO 62 HEIGHT 4 SINGLE
  236. ?
  237. ?? "A&T  MEUBELINDUSTRIE" AT 35
  238. ?
  239. ?? "RAPPORT KLANTENBESTAND" AT 34
  240. ?
  241. ?
  242. ?
  243. ?
  244. RETURN
  245. * EOP: Rintro
  246.  
  247. PROCEDURE Head4
  248. IF gn_level=1
  249.    RETURN
  250. ENDIF
  251. ?? ;
  252. "══════════════════════════════════════════════════════════════════════";
  253. + "══════════";
  254. AT 0
  255. ?
  256. ?? "CATEGORIE: " AT 0,;
  257.  Categorie FUNCTION "T" 
  258. ?
  259. RETURN
  260.  
  261. PROCEDURE __Detail
  262. IF 8 * gn_pspace < gn_atline - (_pspacing * 3 + 1)
  263.    IF gl_widow .AND. _plineno+8 * gn_pspace > gn_atline + 1
  264.       EJECT PAGE
  265.    ENDIF
  266. ENDIF
  267. DO Upd_Vars
  268. ?? "KLANTNR.:  " AT 0,;
  269.  Klant_nr FUNCTION "T" 
  270. ?
  271. ?? Klantnaam FUNCTION "T" AT 0,;
  272.  Telefoon FUNCTION "T" PICTURE "999#9#99999" AT 47
  273. ?
  274. ?? Adres1 FUNCTION "T" AT 0,;
  275.  Adres2 FUNCTION "T" AT 27
  276. ?
  277. ?? Postcode FUNCTION "T" PICTURE "9999 AA" AT 0,;
  278.  "  " ,;
  279.  Woonplaats FUNCTION "T" ,;
  280.  " (" ,;
  281.  Provincie FUNCTION "T" ,;
  282.  ")" 
  283. ?
  284. ?? "CONTACTPERS.: " AT 0,;
  285.  Contact FUNCTION "T" ,;
  286.  Tel_contct FUNCTION "T" PICTURE "XXX#X#XXXXX" AT 47,;
  287.  "TOESTEL: " AT 66,;
  288.  Intern FUNCTION "T" 
  289. ?
  290. ?? "DATUM LAATSTE CONT.: " AT 0,;
  291.  Dat_laatst 
  292. ?
  293. ?? Commentaar FUNCTION "T" AT 0
  294. ?
  295. ?
  296. RETURN
  297. * EOP: __Detail
  298.  
  299. PROCEDURE Foot96
  300. ?? "AANTAL KLANTEN IN BRANCHE " AT 0,;
  301.  r_foot1 FUNCTION "T" ,;
  302.  ": " ,;
  303.  r_msum1 PICTURE "9999" 
  304. ?
  305. ?
  306. RETURN
  307.  
  308. PROCEDURE Rsumm
  309. ?
  310. ?? ;
  311. "══════════════════════════════════════════════════════════════════════";
  312. + "══════════";
  313. AT 0
  314. ?
  315. ?? "TOTAAL AANTAL KLANTEN: " AT 0,;
  316.  r_msum2 PICTURE "9999" 
  317. ?
  318. ?? ;
  319. "══════════════════════════════════════════════════════════════════════";
  320. + "══════════";
  321. AT 0
  322. gl_fandl=.F.        && laatste pagina gereed
  323. ?
  324. RETURN
  325. * EOP: Rsumm
  326.  
  327. PROCEDURE Pgfoot
  328. PRIVATE _box, _pspacing
  329. gl_widow=.F.         && weduwecontrole uitschakelen
  330. _pspacing=1
  331. ?
  332. IF .NOT. gl_plain
  333.    _pspacing=gn_pspace
  334.    ?? "SAMENGESTELD DOOR AFD. VERKOOP" AT 27
  335. ENDIF
  336. EJECT PAGE
  337. *is het paginanummer hoger dan die van de laatste pagina
  338. IF _pageno > _pepage
  339.    GOTO BOTTOM
  340.    SKIP
  341.    gn_level=0
  342. ENDIF
  343. IF .NOT. gl_plain .AND. gl_fandl
  344.    _pspacing=gn_pspace
  345.    DO Pghead
  346. ENDIF
  347. RETURN
  348. * EOP: Pgfoot
  349.  
  350. *-- Pagina-onderbreking bij gebruik van PLAIN-optie.
  351. PROCEDURE Pgplain
  352. PRIVATE _box
  353. EJECT PAGE
  354. RETURN
  355. * EOP: Pgplain
  356.  
  357. *-- dBASE-omgeving opnieuw instellen voordat rapport wordt aangeroepen
  358. PROCEDURE Reset
  359. SET SPACE &gc_space.
  360. SET TALK &gc_talk.
  361. ON ESCAPE
  362. ON PAGE
  363. RETURN
  364. * EOP: Reset
  365.  
  366.