home *** CD-ROM | disk | FTP | other *** search
/ DOS Wares / doswares.zip / doswares / DATABASE / DBASE4NL / SAMPLES.ZIP / NETNUM.FRG < prev    next >
Encoding:
Text File  |  1993-05-18  |  4.3 KB  |  210 lines
  1. * Programma..........: NETNUM.FRG
  2. * Datum..............: 22-04-93
  3. * Versie.............: dBASE IV
  4. *
  5. * Notities:
  6. * --------
  7. * Alvorens 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 < 3
  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. *-- Instellen omgeving
  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          && nummer van actieve pagina vastleggen
  66. gn_page=_pageno     && actieve regelafstand bepalen
  67.  
  68.  
  69. *-- Initiatie van variabelen voor voetregelvelden van groep
  70. IF _pspacing > 1
  71.    gn_atline=_plength - (_pspacing + 1)
  72. ELSE
  73.    gn_atline=_plength - 2
  74. ENDIF
  75. ON PAGE AT LINE gn_atline EJECT PAGE
  76.  
  77. *-- Afdrukken Report
  78.  
  79. PRINTJOB
  80.  
  81. *-- Initialisatie van variabelen voor groeponderbreking.
  82. r_msum1=0
  83.  
  84. IF gl_plain
  85.    ON PAGE AT LINE gn_atline DO Pgplain
  86. ELSE
  87.    ON PAGE AT LINE gn_atline DO Pgfoot
  88. ENDIF
  89.  
  90. DO Pghead
  91.  
  92. gl_fandl=.T.        && eerste pagina gestart
  93.  
  94. DO Rintro
  95.  
  96. *-- Bestandslus
  97. DO WHILE FOUND() .AND. .NOT. EOF() .AND. gl_prntflg
  98.    DO Upd_Vars
  99.    *-- Detailregels
  100.    IF .NOT. gl_summary
  101.       DO Detail
  102.    ENDIF
  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: NETNUM.FRG
  124.  
  125. *-- Update summary fields and/or calculated fields in the detail band.
  126. PROCEDURE Upd_Vars
  127. *-- Summary calculation - Count
  128. r_msum1=r_msum1+1
  129. RETURN
  130. * EOP: Upd_Vars
  131.  
  132. *-- Set flag to get out of DO WHILE loop when escape is pressed.
  133. PROCEDURE prnabort
  134. gl_prntflg=.F.
  135. RETURN
  136. * EOP: prnabort
  137.  
  138. PROCEDURE Pghead
  139. *-- Print HEADING parameter ie. REPORT FORM <name> HEADING <expC>
  140. IF .NOT. gl_plain .AND. gn_length > 0
  141.    ?? gc_heading FUNCTION "I;V"+LTRIM(STR(_rmargin-_lmargin))
  142.    ?
  143. ENDIF
  144. RETURN
  145. * EOP: Pghead
  146.  
  147. PROCEDURE Rintro
  148. ?? "Plaats" STYLE "B" AT 15,
  149. ?? "Kengetal" STYLE "B" AT 47
  150. ?
  151. RETURN
  152. * EOP: Rintro
  153.  
  154. PROCEDURE Detail
  155. ?? WOONPLAATS FUNCTION "T" AT 15,
  156. ?? KENGETAL FUNCTION "T" AT 47,
  157. ?? IIF(deleted(),"Gewist","") FUNCTION "T" PICTURE "XXXXXXXXXX" AT 56
  158. ?
  159. RETURN
  160. * EOP: Detail
  161.  
  162. PROCEDURE Rsumm
  163. ?
  164. ?? "----------" AT 16
  165. ?
  166. ?? "Aantal records: " AT 0,
  167. ?? r_msum1 FUNCTION "I" PICTURE "9999999" 
  168. ?
  169. gl_fandl=.F.        && last page finished
  170. ?
  171. RETURN
  172. * EOP: Rsumm
  173.  
  174. PROCEDURE Pgfoot
  175. PRIVATE _box
  176. gl_widow=.F.         && disable widow checking
  177. ?
  178. IF .NOT. gl_plain
  179. ENDIF
  180. EJECT PAGE
  181. *-- is the page number greater than the ending page
  182. IF _pageno > _pepage
  183.    GOTO BOTTOM
  184.    SKIP
  185.    gn_level=0
  186. ENDIF
  187. IF .NOT. gl_plain .AND. gl_fandl
  188.    DO Pghead
  189. ENDIF
  190. gl_widow=.T.         && enable widow checking
  191. RETURN
  192. * EOP: Pgfoot
  193.  
  194. *-- Process page break when PLAIN option is used.
  195. PROCEDURE Pgplain
  196. PRIVATE _box
  197. EJECT PAGE
  198. RETURN
  199. * EOP: Pgplain
  200.  
  201. *-- Reset dBASE environment prior to calling report
  202. PROCEDURE Reset
  203. SET SPACE &gc_space.
  204. SET TALK &gc_talk.
  205. ON ESCAPE
  206. ON PAGE
  207. RETURN
  208. * EOP: Reset
  209.  
  210.