home *** CD-ROM | disk | FTP | other *** search
/ DOS Wares / doswares.zip / doswares / DATABASE / DBASE4NL / SAMPLES.ZIP / BESTEL.FRG < prev    next >
Encoding:
Text File  |  1993-05-18  |  7.9 KB  |  383 lines
  1. * Programma..........:  BESTEL.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 * 4 + 1) + (_pspacing * 3 + 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 * 3 + 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=KLANT_NR
  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 KLANT_NR <> 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\BESTEL.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 + 5 * gn_pspace
  161. RETURN retval
  162. * EOP: Gheight
  163.  
  164. *Bijwerken van samenvattingsvelden en/of rekenvelden.
  165. PROCEDURE Upd_Vars
  166. r_foot1=Klant_nr
  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_msum1=0
  185.    r_msum2=0
  186. ENDIF
  187. IF gn_level <= 4
  188.    r_mvar4=KLANT_NR
  189. ENDIF
  190. RETURN
  191. * EOP: Grpinit
  192.  
  193. *-- Verwerking van aanhefzones tijdens groeponderbrekingen
  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. *-- Verwerking van samenvattingszones tijdens groeponderbrekingen
  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. PRIVATE ll_heading, ln_width
  229. ll_heading = .T.
  230. ln_width = _rmargin - _lmargin
  231. ?
  232. *-- HEADING-parameter afdrukken - als deze niet op eerste regel past
  233. *-- Waarde toegevoegd aan gn_length is laatste kolom op regel 1 maal twee
  234. IF .NOT. gl_plain .AND. gn_length + 160 > ln_width
  235.    ?? gc_heading FUNCTION "I;V"+LTRIM(STR(ln_width))
  236.    ?
  237.    ll_heading = .F.
  238. ENDIF
  239.  
  240. ?? IIF(gl_plain,'',gd_date) AT 0,;
  241.  "Pag. " AT 71,;
  242.  IIF(gl_plain,'',_pageno) PICTURE "999" 
  243.  
  244. *-- HEADING-parameter afdrukken - als deze op regel een past
  245. IF .NOT. gl_plain .AND. gn_length > 0 .AND. ll_heading
  246.    ?? " "
  247.    ?? gc_heading FUNCTION "I;V"+LTRIM(STR(ln_width-(_pcolno*2)))
  248. ENDIF
  249. ?
  250. ?
  251. ?
  252. RETURN
  253. * EOP: Pghead
  254.  
  255. PROCEDURE Rintro
  256. ?
  257. DEFINE BOX FROM 25 TO 58 HEIGHT 4 DOUBLE
  258. ?
  259. ?? "A&T  MEUBELINDUSTRIE" AT 32
  260. ?
  261. ?? "RAPPORT BESTELLINGEN" AT 32
  262. ?
  263. ?
  264. ?
  265. RETURN
  266. * EOP: Rintro
  267.  
  268. PROCEDURE Head4
  269. IF gn_level=1
  270.    RETURN
  271. ENDIF
  272. ?? ;
  273. "══════════════════════════════════════════════════════════════════════";
  274. + "══════════";
  275. STYLE "BU" AT 0
  276. ?
  277. ?? "KLANTNUMMER: " STYLE "BU" AT 0,;
  278.  Klant_nr FUNCTION "T" STYLE "BU" 
  279. ?
  280. RETURN
  281.  
  282. PROCEDURE __Detail
  283. IF 5 * gn_pspace < gn_atline - (_pspacing * 4 + 1)
  284.    IF gl_widow .AND. _plineno+5 * gn_pspace > gn_atline + 1
  285.       EJECT PAGE
  286.    ENDIF
  287. ENDIF
  288. DO Upd_Vars
  289. ?? "BESTELDATUM: " AT 0,;
  290.  Dat_trans ,;
  291.  "ONDERDEELNR.: " AT 36,;
  292.  Ondrdl_nr FUNCTION "T" ,;
  293.  "AANTAL: " AT 68,;
  294.  Ondrdl_ant PICTURE "999" 
  295. ?
  296. ?? "MAGAZIJNNR.: " AT 0,;
  297.  Magazn_nr FUNCTION "T" 
  298. ?
  299. ?? "VERKOCHT DOOR WERKNEMER: " AT 0,;
  300.  Pers_nr FUNCTION "T" ,;
  301.  "FACTUUR: " AT 68,;
  302.  Factuur PICTURE "Y" 
  303. ?
  304. ?? "OPMERKING:   " AT 0,;
  305.  Info FUNCTION "V50" 
  306. ?
  307. ?? ;
  308. "──────────────────────────────────────────────────────────────────────";
  309. + "──────────";
  310. AT 0
  311. ?
  312. RETURN
  313. * EOP: __Detail
  314.  
  315. PROCEDURE Foot96
  316. ?? "AANTAL BESTELLINGEN VOOR KLANT " AT 0,;
  317.  r_foot1 FUNCTION "T" ,;
  318.  ": " ,;
  319.  r_msum1 PICTURE "999" 
  320. ?
  321. ?? ;
  322. "══════════════════════════════════════════════════════════════════════";
  323. + "══════════";
  324. AT 0
  325. ?
  326. ?
  327. RETURN
  328.  
  329. PROCEDURE Rsumm
  330. ?? "TOTAAL AANTAL BESTELLINGEN: " AT 0,;
  331.  r_msum2 PICTURE "999" 
  332. ?
  333. ?? ;
  334. "══════════════════════════════════════════════════════════════════════";
  335. + "══════════";
  336. AT 0
  337. gl_fandl=.F.        && laatste pagina gereed
  338. ?
  339. RETURN
  340. * EOP: Rsumm
  341.  
  342. PROCEDURE Pgfoot
  343. PRIVATE _box, _pspacing
  344. gl_widow=.F.         && weduwecontrole uitschakelen
  345. _pspacing=1
  346. ?
  347. IF .NOT. gl_plain
  348.    _pspacing=gn_pspace
  349.    ?
  350.    ?? "SAMENGESTELD DOOR AFDELING VERKOOP" AT 30
  351.    ?
  352. ENDIF
  353. EJECT PAGE
  354. *is het paginanummer hoger dan die van de laatste pagina
  355. IF _pageno > _pepage
  356.    GOTO BOTTOM
  357.    SKIP
  358.    gn_level=0
  359. ENDIF
  360. IF .NOT. gl_plain .AND. gl_fandl
  361.    _pspacing=gn_pspace
  362.    DO Pghead
  363. ENDIF
  364. RETURN
  365. * EOP: Pgfoot
  366.  
  367. *-- Pagina-onderbreking bij gebruik van PLAIN-optie.
  368. PROCEDURE Pgplain
  369. PRIVATE _box
  370. EJECT PAGE
  371. RETURN
  372. * EOP: Pgplain
  373.  
  374. *-- dBASE-omgeving opnieuw instellen voordat rapport wordt aangeroepen
  375. PROCEDURE Reset
  376. SET SPACE &gc_space.
  377. SET TALK &gc_talk.
  378. ON ESCAPE
  379. ON PAGE
  380. RETURN
  381. * EOP: Reset
  382.  
  383.