home *** CD-ROM | disk | FTP | other *** search
/ DOS Wares / doswares.zip / doswares / DATABASE / DBASE4NL / SAMPLES.ZIP / PERSONEL.FRG < prev    next >
Encoding:
Text File  |  1993-05-18  |  6.2 KB  |  296 lines
  1. * Programma..........:  PERSONEL.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.  
  70. *-- Instellen van pagina-onderbrekingen
  71. gn_atline=_plength - (_pspacing + 1)
  72. ON PAGE AT LINE gn_atline EJECT PAGE
  73.  
  74. *-- Afdrukken rapport
  75.  
  76. PRINTJOB
  77.  
  78. *-- Initiatie van samenvattingsvelden.
  79. r_msum1=0
  80.  
  81. IF gl_plain
  82.    ON PAGE AT LINE gn_atline DO Pgplain
  83. ELSE
  84.    ON PAGE AT LINE gn_atline DO Pgfoot
  85. ENDIF
  86.  
  87. DO Pghead
  88.  
  89. gl_fandl=.T.        && eerste pagina gestart
  90.  
  91. DO Rintro
  92.  
  93. *-- Bestandslus
  94. DO WHILE FOUND() .AND. .NOT. EOF() .AND. gl_prntflg
  95.    gn_level=0
  96.    *-- Detailregels
  97.    IF gl_summary
  98.       DO Upd_Vars
  99.    ELSE
  100.       DO __Detail
  101.    ENDIF
  102.    gl_widow=.T.         && weduwecontrole inschakelen
  103.    CONTINUE
  104. ENDDO
  105.  
  106. IF gl_prntflg
  107.    DO Rsumm
  108.    IF _plineno <= gn_atline
  109.       EJECT PAGE
  110.    ENDIF
  111. ELSE
  112.    DO Rsumm
  113.    DO Reset
  114.    RETURN
  115. ENDIF
  116.  
  117. ON PAGE
  118.  
  119. ENDPRINTJOB
  120.  
  121. DO Reset
  122. RETURN
  123. * EOP: C:\NL_15\DATA\PERSONEL.FRG
  124.  
  125. *Bijwerken van samenvattingsvelden en/of rekenvelden.
  126. PROCEDURE Upd_Vars
  127. *telling
  128. r_msum1=r_msum1+1
  129. RETURN
  130. * EOP: Upd_Vars
  131.  
  132. *-- Vlag instellen zodat met ESC de DO WHILE-lus wordt verlaten
  133. PROCEDURE Prnabort
  134. gl_prntflg=.F.
  135. RETURN
  136. * EOP: Prnabort
  137.  
  138. PROCEDURE Pghead
  139. PRIVATE ll_heading, ln_width
  140. ll_heading = .T.
  141. ln_width = _rmargin - _lmargin
  142. ?
  143. *-- HEADING-parameter afdrukken - als deze niet op eerste regel past
  144. *-- Waarde toegevoegd aan gn_length is laatste kolom op regel 1 maal twee
  145. IF .NOT. gl_plain .AND. gn_length + 162 > ln_width
  146.    ?? gc_heading FUNCTION "I;V"+LTRIM(STR(ln_width))
  147.    ?
  148.    ll_heading = .F.
  149. ENDIF
  150.  
  151. ?? IIF(gl_plain,'',gd_date) AT 0,;
  152.  "Pag. " AT 72,;
  153.  IIF(gl_plain,'',_pageno) PICTURE "999" 
  154.  
  155. *-- HEADING-parameter afdrukken - als deze op regel een past
  156. IF .NOT. gl_plain .AND. gn_length > 0 .AND. ll_heading
  157.    ?? " "
  158.    ?? gc_heading FUNCTION "I;V"+LTRIM(STR(ln_width-(_pcolno*2)))
  159. ENDIF
  160. ?
  161. ?
  162. RETURN
  163. * EOP: Pghead
  164.  
  165. PROCEDURE Rintro
  166. ?
  167. DEFINE BOX FROM 24 TO 56 HEIGHT 4 SINGLE
  168. ?
  169. ?? "A&T MEUBELINDUSTRIE" AT 31
  170. ?
  171. ?? "PERSONEELSRAPPORT" AT 32
  172. ?
  173. ?
  174. ?
  175. ?? ;
  176. "══════════════════════════════════════════════════════════════════════";
  177. + "══════════";
  178. AT 0
  179. ?
  180. RETURN
  181. * EOP: Rintro
  182.  
  183. PROCEDURE __Detail
  184. IF 11 * gn_pspace < gn_atline - (_pspacing * 3 + 1)
  185.    IF gl_widow .AND. _plineno+11 * gn_pspace > gn_atline + 1
  186.       EJECT PAGE
  187.    ENDIF
  188. ENDIF
  189. DO Upd_Vars
  190. ?
  191. ?? Achternaam FUNCTION "T" AT 0,;
  192.  ", " ,;
  193.  Voornaam FUNCTION "T" ,;
  194.  " " ,;
  195.  Invoeg FUNCTION "T" PICTURE "XXXXXXX" ,;
  196.  "NR.: " AT 38,;
  197.  Pers_nr FUNCTION "T" ,;
  198.  Telefoon FUNCTION "T" PICTURE "XXX#X#XXXXX" AT 58
  199. ?
  200. ?? Adres1 FUNCTION "T" AT 0,;
  201.  "   " ,;
  202.  Adres2 FUNCTION "T" 
  203. ?
  204. ?? Postcode FUNCTION "T" AT 0,;
  205.  "  " ,;
  206.  Woonplaats FUNCTION "T" ,;
  207.  " (" ,;
  208.  Provincie FUNCTION "T" PICTURE "XXX" ,;
  209.  ")" 
  210. ?
  211. ?? "AFDELING: " AT 5,;
  212.  Afdeling FUNCTION "T" ,;
  213.  "SALARIS: ƒ " AT 58,;
  214.  Salaris FUNCTION "B" PICTURE "999999.99" 
  215. ?
  216. ?? Functie FUNCTION "T" AT 15,;
  217.  Branche FUNCTION "T" PICTURE "XXXXXXXXXXXXXXX" AT 38,;
  218.  "TOESLAG: " AT 58,;
  219.  Toeslag PICTURE "99.9" ,;
  220.  "%" 
  221. ?
  222. ?? "IN DIENST PER: " AT 0,;
  223.  In_dienst ,;
  224.  "TITEL: " AT 38,;
  225.  Titel FUNCTION "T" ,;
  226.  "DIENSTJAREN: " AT 58,;
  227.  Dienstjr PICTURE "99" 
  228. ?
  229. ?? "SPAARFONDS: " AT 3,;
  230.  Spaarfonds PICTURE "Y" ,;
  231.  "DEELTIJD: " AT 38,;
  232.  Deeltijd PICTURE "Y" 
  233. ?
  234. ?? "BONUS: " AT 8,;
  235.  Bonus FUNCTION "T" ,;
  236.  "SCHAAL: " AT 38,;
  237.  Schaal PICTURE "9" 
  238. ?
  239. ?? "INFO: " AT 9,;
  240.  Info FUNCTION "T" 
  241. ?
  242. ?? ;
  243. "──────────────────────────────────────────────────────────────────────";
  244. + "──────────";
  245. AT 0
  246. ?
  247. RETURN
  248. * EOP: __Detail
  249.  
  250. PROCEDURE Rsumm
  251. ?? "AANTAL WERKNEMERS: " AT 0,;
  252.  r_msum1 PICTURE "9999" 
  253. gl_fandl=.F.        && laatste pagina gereed
  254. ?
  255. RETURN
  256. * EOP: Rsumm
  257.  
  258. PROCEDURE Pgfoot
  259. PRIVATE _box, _pspacing
  260. gl_widow=.F.         && weduwecontrole uitschakelen
  261. _pspacing=1
  262. ?
  263. IF .NOT. gl_plain
  264.    _pspacing=gn_pspace
  265. ENDIF
  266. EJECT PAGE
  267. *is het paginanummer hoger dan die van de laatste pagina
  268. IF _pageno > _pepage
  269.    GOTO BOTTOM
  270.    SKIP
  271.    gn_level=0
  272. ENDIF
  273. IF .NOT. gl_plain .AND. gl_fandl
  274.    _pspacing=gn_pspace
  275.    DO Pghead
  276. ENDIF
  277. RETURN
  278. * EOP: Pgfoot
  279.  
  280. *-- Pagina-onderbreking bij gebruik van PLAIN-optie.
  281. PROCEDURE Pgplain
  282. PRIVATE _box
  283. EJECT PAGE
  284. RETURN
  285. * EOP: Pgplain
  286.  
  287. *-- dBASE-omgeving opnieuw instellen voordat rapport wordt aangeroepen
  288. PROCEDURE Reset
  289. SET SPACE &gc_space.
  290. SET TALK &gc_talk.
  291. ON ESCAPE
  292. ON PAGE
  293. RETURN
  294. * EOP: Reset
  295.  
  296.