home *** CD-ROM | disk | FTP | other *** search
/ C!T ROM 2 / ctrom_ii_b.zip / ctrom_ii_b / PROGRAM / BASIC / QBDBAS / VERKOPEN.BAS < prev    next >
BASIC Source File  |  1991-10-20  |  18KB  |  468 lines
  1. ' DEMONSTRATIE PROGRAMMA VERKOOP STATISTIEK.
  2. '
  3. ' Een praktische toepassing van het behandelen van een dBase3/4 bestand
  4. ' met QuickBasic of QBasic.
  5. '
  6. ' -----------------------------------------------------------------------
  7. '
  8. ' Doel:    Het maken van grafieken van de verkoop per land en per periode.
  9. '
  10. ' Werking: Met het programma QBDBASE.BAS van BLOKKER+BLOKKER kan de
  11. '          struktuur en de record lay-out van het dBase III bestand
  12. '          VERKOPEN.DBF worden bekeken. Daarbij blijkt, dat de Header
  13. '          van VERKOPEN.DBF 129 bytes lang is. De record lay-out is
  14. '          als volgt:
  15. '
  16. '          Status       1 byte    Tekst
  17. '          LAND         7 bytes   Tekst
  18. '          MAAND        2 bytes   Tekst
  19. '          AANTAL       6 bytes   Getal - 0 decimalen.
  20. '
  21. '          Alle records worden gelezen, waarbij records, waarvan in
  22. '          het Statusveld een "*" staat, worden overgeslagen. Na het
  23. '          verzamelen van de gegevens worden twee staafdiagrammen op
  24. '          het scherm getoond.
  25. '
  26. '          De gegevens die voor deze verschillende staafdiagrammen nodig
  27. '          zijn, worden in één run verzameld. De grafieken kunnen geprint
  28. '          worden. U dient echter vooraf het commando GRAPHICS te geven.
  29. '
  30. '          Dit programma is geschikt voor pc's die SCREEN 2 ondersteunen.
  31. '
  32. ' -----------------------------------------------------------------------
  33.  
  34. DEFINT A-Z
  35.  
  36. ' de lay-out van de records van VERKOOP.DBF
  37. '
  38. TYPE VerkoopRecord
  39.   Status AS STRING * 1                      ' "*" - RECORD GEDELETE.
  40.   Land AS STRING * 7                        ' Land naam
  41.   Maand AS STRING * 2                       ' Maand aanduding 01 02 etc.
  42.   Aantal AS STRING * 6                      ' Aantal verkocht.
  43. END TYPE
  44.  
  45. ' Telling per land records
  46. '
  47. TYPE LandTelling
  48.   Land AS STRING * 7
  49.   Totaal AS LONG
  50. END TYPE
  51.  
  52. ' Telling per maand records
  53. '
  54. TYPE MaandTelling
  55.   Maand AS STRING * 2
  56.   Totaal AS LONG
  57. END TYPE
  58.  
  59. ' -----------------------------------------------------------------------
  60. DECLARE SUB OpendBFile ()
  61. DECLARE SUB Grafieken ()
  62. DECLARE FUNCTION BestandAanwezig% (Bestand$)
  63.  
  64. ' -----------------------------------------------------------------------
  65. DIM SHARED dbFile$                                ' dBase file naam
  66. DIM SHARED dBHandle%                              ' dbase file handle
  67. DIM SHARED DiskFout%                              ' Boolean ON ERROR var.
  68. DIM SHARED HeaderLengte%                          ' Lengte van dBase header.
  69.  
  70. ' -----------------------------------------------------------------------
  71. CLS
  72. ON ERROR GOTO Foutje                              ' Algemene fout afhandeling.
  73.  
  74. dbFile$ = "VERKOPEN.DBF"                          ' bekend gegeven.
  75. CALL OpendBFile                                   ' file openen
  76.  
  77. HeaderLengte% = 129                               ' bekend gegeven.
  78. CALL Grafieken                                    ' Grafieken tekenen.
  79. CLOSE
  80.  
  81. PRINT
  82. PRINT SPC(17); "Vriendelijke groeten van BLOKKER+BLOKKER"
  83. PRINT SPC(17); "  Postbus 71992 - 1008 ED  Amsterdam"
  84. PRINT SPC(17); "          020 - 6.42.32.75"
  85. PRINT
  86. PRINT SPC(9); "TurboFlow! is onmisbaar voor elke QuickBasic programmeur !"
  87. PRINT SPC(9); STRING$(58, "─")
  88. END
  89.  
  90. ' -----------------------------------------------------------------------
  91. ' Fouten afhandeling:
  92. '
  93. Foutje:
  94. CLOSE
  95. PRINT
  96. PRINT "Error :"; ERR
  97. RESUME StopProgramma
  98.  
  99. StopProgramma:
  100. END
  101.  
  102. ' -----------------------------------------------------------------------
  103. ' Speciale foutroutine. Wordt aangeroepen in de funktie BestandAanwezig.
  104. '
  105. FoutBestand:
  106. DiskFout% = -1
  107. RESUME NEXT
  108.  
  109. '
  110. ' That's all, Folks!
  111. ' ------------------------------------------------------------------------
  112.  
  113. FUNCTION BestandAanwezig% (Bestand$)
  114.  
  115. ' --------------------------------------------------------------------
  116. ' Funktie : kontroleer of een bestand aanwezig is.
  117. '
  118. ' De werking is als volgt. Eerst wordt de opdracht gegeven om
  119. ' bij een volgende fout niet naar het label "Foutje:" te springen
  120. ' maar naar het label "FoutBestand:"
  121. ' Daarna wordt de SHARED variabele DiskFout% in deze routine op nul gezet.
  122. ' Er wordt dus aangenomen dat er geen fout zal optreden.
  123. '
  124. ' Als het bestand niet aanwezig is dan zal de ON ERROR routine naar
  125. ' het label "FoutBestand:" springen. Op die plaats wordt de SHARED
  126. ' variabele DiskFout% op -1 gezet en er wordt met RESUME NEXT voor
  127. ' gezorgd dat met de volgende programmaregel in deze routine wordt
  128. ' verder gegaan. Dan wordt de variabele DiskFout% getest. Als DiskFout%
  129. ' nog steeds 0 is, dan is er geen fout opgetreden. Als DiskFout%
  130. ' in de error trap routine op -1 is gezet, dan is het bestand niet
  131. ' gevonden of het kon niet worden geopend.
  132. '
  133. ' In de Hoofdroutine moet u de variabale Diskfout% SHARED verklaren met:
  134. '   DIM SHARED DiskFout%
  135. '
  136. ' --------------------------------------------------------------------
  137.  
  138. DiskFout% = 0                          ' reset SHARED variabele DiskFout%
  139. FileNr% = FREEFILE                     ' file handle.
  140.  
  141. ON ERROR GOTO FoutBestand              ' tijdelijk omleiden van ON ERROR
  142. OPEN Bestand$ FOR INPUT AS #FileNr%    ' probeer te openen
  143. CLOSE #FileNr%                         ' en weer sluiten
  144.  
  145. IF DiskFout% THEN                      ' Ai! niet gelukt...
  146.   BestandAanwezig% = 0                 ' .. geef False terug
  147. ELSE                                   ' anders
  148.   BestandAanwezig% = -1                ' ..Bingo! bestand aanwezig.
  149. END IF
  150. ON ERROR GOTO Foutje                   ' reset Algemene fouten opvang.
  151.  
  152.  
  153. ' Onderaan in de Hoofdroutine de volgende regels plaatsen:
  154. '
  155. ' FoutBestand:
  156. '   DiskFout% = -1
  157. '   RESUME NEXT
  158.  
  159. END FUNCTION
  160.  
  161. SUB Grafieken
  162.  
  163. ' Funktie    : Lees het dBase III bestand VERKOPEN.DBF.
  164. '              Verzamel de verkoopcijfers per land en per maand.
  165. '              Maak van die gegevens grafieken op het scherm.
  166. '
  167. ' Werkwijze  : Het totale dBase bestand VERKOPEN.DBF woordt doorlopen.
  168. '              In fixed records worden de land- maandaanduidingen
  169. '              opgeslagen en het totaal per item wordt geteld. De records
  170. '              mogen in VERKOPEN.DBF volkomen door elkaar staan. De
  171. '              subtotalen worden steeds in hun eigen TYPE record geteld.
  172. '      
  173. ' Variabelen : Hier wordt gewerkt met de volgende TYPE variabelen:
  174. '
  175. '              TYPE VerkoopRecord
  176. '                   Status AS STRING * 1         Ge-delete of niet
  177. '                   Land AS STRING * 7           Land naam
  178. '                   Maand AS STRING * 2          Maand 01, 02, 03 etc.
  179. '                   Aantal AS STRING * 6         getal.
  180. '
  181. '              TYPE LandTelling                  6 landen aanwezig
  182. '                   Land AS STRING * 7
  183. '                   Totaal AS LONG
  184. '
  185. '              TYPE MaandTelling                 12 maanden aanwezig
  186. '                   Maand AS STRING * 2
  187. '                   Totaal AS LONG
  188.  
  189.  
  190. DIM REC AS VerkoopRecord                    ' record in VERKOPEN.DBF
  191. DIM PerLand(6) AS LandTelling               ' telling per land
  192. DIM PerMaand(12) AS MaandTelling            ' en telling per maand
  193. DIM DelRec&
  194.  
  195. ' Bereken aantal records in VERKOPEN.DBF.
  196. '
  197. AantalRecs& = (LOF(dBHandle%) - HeaderLengte%) \ LEN(REC)
  198.  
  199. ' Positioneer de leeskop.
  200. '
  201. SEEK #dBHandle%, HeaderLengte% + 1
  202.  
  203. LOCATE 1, 20
  204. PRINT "EUROPA - VERKOPEN PER LAND EN PER MAAND 1991";
  205. PRINT STRING$(80, "─");
  206. LOCATE 5, 1
  207. PRINT "PER LAND          AANTAL                PER MAAND           AANTAL"
  208. PRINT "─────────────── ────────                ───────────────── ────────"
  209.  
  210. LandIndex% = 0                                 ' init Land Index.
  211. FOR X& = 1 TO AantalRecs&                      ' lees alle records
  212.   GET #dBHandle%, , REC                        ' .. in type REC.
  213.                                                ' niet gedelete ?
  214.   IF REC.Status <> "*" THEN                    ' init Boolean
  215.     LandOK% = 0                                ' zoek in de PerLand(). records
  216.     FOR X% = 1 TO LandIndex%                   '
  217.       IF PerLand(X%).Land = REC.Land THEN      ' reeds aanwezig ?
  218.         LandOK% = -1                           ' dan ok.
  219.         EXIT FOR
  220.       END IF
  221.     NEXT X%
  222.  
  223.     IF NOT LandOK% THEN                        ' kwam land nog niet voor ?
  224.       LandIndex% = LandIndex% + 1              ' verhoog de index
  225.       PerLand(LandIndex%).Land = REC.Land      ' plaats naam in variabele
  226.       X% = LandIndex%                          ' kopieer naar X%
  227.     END IF
  228.  
  229.     PerLand(X%).Totaal = PerLand(X%).Totaal + VAL(REC.Aantal) ' subtotaal.
  230.     LOCATE X% + 6, 1                               ' toon op scherm
  231.     PRINT PerLand(X%).Land,                        ' .. land naam en
  232.     PRINT USING "##########"; PerLand(X%).Totaal;  ' .. subtotaal.
  233.  
  234.     MaandIndex% = VAL(REC.Maand)                   ' welke maand ?
  235.     PerMaand(MaandIndex%).Maand = REC.Maand        ' tel subtotaal en kopieer.
  236.     PerMaand(MaandIndex%).Totaal = PerMaand(MaandIndex%).Totaal + VAL(REC.Aantal)
  237.           
  238.     LOCATE MaandIndex% + 6, 41                     ' toon op scherm
  239.     PRINT PerMaand(MaandIndex%).Maand,             ' .. maand en subtotaal
  240.     PRINT USING "##########"; PerMaand(MaandIndex%).Totaal;
  241.   ELSE
  242.     DelRec& = DelRec& + 1
  243.   END IF ' Status
  244. NEXT X&
  245.  
  246. ' Het hele bestand is nu doorlopen en alles is in één keer
  247. ' verzameld en geteld. Toon de Totaal Generaal telling en
  248. ' bepaal ook meteen welk land en welke maand de hoogste omzet gaven.
  249. '
  250. LOCATE 19, 1
  251. PRINT "                ────────                                  ────────"
  252. PRINT "Totaal :                                Totaal :"
  253.  
  254. MaxLand& = 0                                   ' Hoogste omzet per land.
  255. FOR X% = 1 TO 6                                ' 6 landen
  256.   TGLand& = TGLand& + PerLand(X%).Totaal       ' Tel totaal generaal.
  257.   IF PerLand(X%).Totaal > MaxLand& THEN        ' meer dan MaxLand&
  258.     MaxLand& = PerLand(X%).Totaal              ' .. kopieer.
  259.   END IF
  260. NEXT X%
  261. LOCATE 20, 15                                  ' druk af op scherm.
  262. PRINT USING "##########"; TGLand&
  263.  
  264. MaxMaand& = 0                                  ' Hoogste omzet van een maand
  265. FOR X% = 1 TO 12                               ' 12 maanden
  266.   TGMaand& = TGMaand& + PerMaand(X%).Totaal    ' Tel totaal generaal
  267.   IF PerMaand(X%).Totaal > MaxMaand& THEN      ' meer dan MaxMaand?
  268.     MaxMaand& = PerMaand(X%).Totaal            ' .. kopieer
  269.   END IF
  270. NEXT X%
  271. LOCATE 20, 57                                  ' druk af op scherm.
  272. PRINT USING "##########"; TGMaand&
  273. '
  274. ' De twee totaal generaal tellingen zijn natuurlijk altijd gelijk aan elkaar.
  275.  
  276. PRINT
  277. PRINT DelRec&; "gedelete record(s) niet meegeteld."
  278.  
  279. LOCATE 24, 1
  280. PRINT "Druk op een toets...";
  281.  
  282. I$ = ""
  283. DO
  284.   I$ = INKEY$
  285. LOOP UNTIL I$ = CHR$(32)
  286.  
  287. SCREEN 2
  288.  
  289. ' ------------------------------------------------------------------------
  290. ' Teken staafdiagram per Land
  291. '
  292. LINE (0, 0)-(639, 199), , B                             ' kader
  293. LINE (132, 15)-(450, 40), , B                           ' kop tekst
  294. PAINT (133, 16), CHR$(136) + CHR$(34)
  295. LOCATE 4, 23
  296. PRINT " OMZET PER LAND IN AANTALLEN "
  297.  
  298. LINE (20, 150)-(610, 150)                               ' bodem lijn
  299.  
  300. Y% = 20                                                 ' start pixel
  301. FOR X% = 1 TO 6                                         ' 6 maanden
  302.   Top% = 150 - ((PerLand(X%).Totaal * 100) \ MaxLand&)  ' bereken hoogte staaf
  303.   LINE (Y%, Top%)-(Y% + 90, 150), , B                   ' teken staaf
  304.   IF Top% < 149 THEN                                    ' vul staaf met
  305.     IF X% MOD 2 = 0 THEN                                ' diagoale lijnen
  306.       PAINT (Y% + 1, 149), CHR$(1) + CHR$(4) + CHR$(16) + CHR$(64)
  307.     ELSE
  308.       PAINT (Y% + 1, 149), CHR$(64) + CHR$(16) + CHR$(4) + CHR$(1)
  309.     END IF
  310.   END IF
  311.   LOCATE 21, (Y% \ 8) + 3                               ' toon totaal per land
  312.   PRINT PerLand(X%).Totaal;
  313.   LOCATE 23, (Y% \ 8) + 3                               ' toon landnaam
  314.   PRINT PerLand(X%).Land;
  315.   Y% = Y% + 100                                         ' verhoog start pixel.
  316. NEXT X%
  317.  
  318. I$ = ""
  319. DO
  320.   I$ = INKEY$
  321. LOOP UNTIL I$ = CHR$(32)
  322.  
  323.  
  324. CLS
  325.  
  326. ' ------------------------------------------------------------------------
  327. ' Teken staafdiagram per maand
  328. '
  329. LINE (0, 0)-(639, 199), , B                             ' kader
  330. LINE (132, 15)-(450, 40), , B                           ' kop tekst
  331. PAINT (133, 16), CHR$(136) + CHR$(34)
  332. LOCATE 4, 23
  333. PRINT " OMZET PER MAAND IN AANTALLEN "
  334.  
  335. LINE (20, 150)-(610, 150)                               ' bodem lijn
  336. Y% = 20                                                 ' start pixel
  337. FOR X% = 1 TO 12                                        ' 12 maanden
  338.   Top% = 150 - ((PerMaand(X%).Totaal * 100) \ MaxMaand&)  ' staaf hoogte
  339.   LINE (Y%, Top%)-(Y% + 45, 150), , B                     ' teken staaf
  340.   IF Top% < 149 THEN                                      ' vul met diagonalen
  341.     IF X% MOD 2 = 0 THEN
  342.       PAINT (Y% + 1, 149), CHR$(1) + CHR$(4) + CHR$(16) + CHR$(64)
  343.     ELSE
  344.       PAINT (Y% + 1, 149), CHR$(64) + CHR$(16) + CHR$(4) + CHR$(1)
  345.     END IF
  346.   END IF
  347.   LOCATE 21, (Y% \ 8) + 1                                 ' toon maand totaal
  348.   PRINT PerMaand(X%).Totaal;
  349.   LOCATE 23, (Y% \ 8) + 3                                 ' maand aanduding
  350.   PRINT PerMaand(X%).Maand;
  351.   Y% = Y% + 50
  352. NEXT X%                                                   ' verhoog start pixel
  353. ON ERROR GOTO 0
  354.  
  355.  
  356. I$ = ""
  357. DO
  358.   I$ = INKEY$
  359. LOOP UNTIL I$ = CHR$(32)
  360.  
  361.  
  362. ' ------------------------------------------------------------------------
  363. ' Teken lijngrafiek per maand
  364. '
  365.  
  366. M$ = "JANFEBMRTAPRMEIJUNJULAUGSEPOKTNOVDEC"
  367.  
  368. LINE (0, 0)-(639, 199), 7, BF                             ' kader
  369. LINE (0, 0)-(639, 199), 0, B                                  ' kader
  370. LINE (132, 15)-(450, 40), 0, B                            ' kop tekst
  371. PAINT (133, 16), CHR$(136) + CHR$(34)                     ' vul blok
  372. LOCATE 4, 23
  373. PRINT " Omzet per maand in aantallen "                    ' tekst
  374. REDIM Array%(2000)
  375.  
  376. GET (22 * 8, 3 * 8)-(52 * 8 - 1, 4 * 8 - 1), Array%(0)    ' reverse color
  377. PUT (22 * 8, 3 * 8), Array%(0), PRESET
  378.  
  379. LINE (60, 152)-(610, 152), 0                              ' X-As
  380. LINE (60, 20)-(60, 152), 0                                ' Y-As
  381.  
  382. Afstand% = 152 \ (MaxMaand& \ 200)                        ' maak
  383. FOR X% = (152 - Afstand%) TO 24 STEP -Afstand%            ' verdeel streepjes.
  384.   LINE (40, X%)-(60, X%), 0
  385. NEXT X%
  386.  
  387. YY% = 140                                                 ' Verticaal het
  388. ZZ% = 16                                                  ' woord AAANTAL
  389.  
  390. FOR X% = (42 * 8) TO ((51 * 8) - 1)                       ' lees het woord
  391.   FOR Y% = 24 TO 31                                       ' AANTALLEN uit
  392.     Z% = POINT(X%, Y%)                                    ' het scherm en
  393.     IF Z% = 0 THEN                                        ' plaats het
  394.       PRESET (ZZ%, YY%), 0                                ' verticaal aan de
  395.       PRESET (ZZ% + 1, YY%), 0                            ' linkerzijde van
  396.     END IF                                                ' de Y-as.
  397.     ZZ% = ZZ% + 2
  398.     IF ZZ% > 31 THEN
  399.       ZZ% = 16
  400.       YY% = YY% - 1
  401.     END IF
  402.   NEXT Y%
  403. NEXT X%
  404.        
  405. Y% = 96                                                   ' start pixel
  406. FOR X% = 1 TO 12                                          ' 12 maanden
  407.   Top% = 152 - ((PerMaand(X%).Totaal * 100) \ MaxMaand&)  ' staaf hoogte
  408.   LINE (Y% - 4, Top% - 2)-(Y% + 4, Top% + 2), 0, B        ' markeer punt.
  409.   IF X% > 1 THEN
  410.     LINE (VorigeY%, VorigeTop%)-(Y%, Top%), 0             ' teken grafiek
  411.   END IF
  412.   VorigeY% = Y%                                           ' kopieer
  413.   VorigeTop% = Top%
  414.  
  415.   Rij% = (Top% \ 8) - 1                                   ' Bereken de rij
  416.   Kol = Y% \ 8                                            ' en de kolom.
  417.   LOCATE Rij%, Kol%                                       '
  418.   Waarde$ = MID$(STR$(PerMaand(X%).Totaal), 2)            ' uit record.
  419.   PRINT Waarde$;                                          ' toon waarde.
  420.                                                           ' maak reverse.
  421.   GET ((Kol% - 1) * 8, (Rij% - 1) * 8)-(((Kol% + LEN(Waarde$) - 1) * 8) - 1, (Rij% * 8) - 1), Array%(0)
  422.   PUT ((Kol% - 1) * 8, (Rij% - 1) * 8), Array(0), PRESET
  423.  
  424.   Rij% = 21                                               ' bepaal de rij
  425.   Kol% = (Y% \ 8)                                         ' en de kolom.
  426.   LOCATE Rij%, Kol%                                       '
  427.   PRINT MID$(M$, VAL(PerMaand(X%).Maand) * 3 - 2, 3);     ' print maand.
  428.                                                           ' maak reverse.
  429.   GET ((Kol% - 1) * 8, (Rij% - 1) * 8)-(((Kol% + 2) * 8) - 1, (Rij% * 8) - 1), Array%(0)
  430.   PUT ((Kol% - 1) * 8, (Rij% - 1) * 8), Array(0), PRESET
  431.  
  432.   Y% = Y% + 40
  433. NEXT X%                                                   ' verhoog start pixel
  434.  
  435. I$ = ""
  436. DO
  437.   I$ = INKEY$
  438. LOOP UNTIL I$ = CHR$(32)
  439.  
  440. SCREEN 0
  441.  
  442. END SUB
  443.  
  444. SUB OpendBFile
  445.  
  446. ' Funktie  : Kontroleer of dBase bestand aanwezig is.
  447. '            Zo ja, OPEN de file FOR BINARY en lees het
  448. '            het eerste blok van 32 bytes in.
  449. '
  450. ' Gebruikt : FUNCTION BestandAanwezig%(File$)
  451. '
  452. ' Shared   : dBFile$     - naam van het database bestand.
  453. '            Header      - lay-out van het eerste blok van 32 bytes.
  454. ' ------------------------------------------------------------------
  455.  
  456. IF BestandAanwezig%(dbFile$) THEN
  457.   dBHandle% = FREEFILE
  458.   OPEN dbFile$ FOR BINARY AS #dBHandle%             ' o.k.
  459.   GET #dBHandle%, , Header                          ' lees header string.
  460. ELSE
  461.   PRINT
  462.   PRINT "Bestand "; dbFile$; " niet gevonden ..."
  463.   END
  464. END IF
  465.  
  466. END SUB
  467.  
  468.