06_Adresbestand.bc3

1000 GOSUB270:A=0.9*FR-350:GOTO20:REM  NAWP-BESTAND
1010 GOSUB270
1020 MR=INT((FR-1000)/150):REM  MAXIMUM AANTAL RECORDS
1030 MV=5:REM  MAXIMUM AANTAL VELDEN
1040 LR$="":FORI=1 TOHO:LR$=LR$+" ":NEXTI
1050 DIMSO(40),RI$(MV),DE$(MV),BE$(MR,MV)
1060 AR=0:REM  0 RECORDS AANWEZIG
1070 VS=0:REM  SORTEER OP NAAM
1080 NU=1:REM  HUIDIG RECORD
1090 READMV
1100 FORJ=0 TOMV:READDE$(J):BE$(0,J)="":NEXTJ
1110 VT=VE:HT=HO
1500 REM
1510 REM  HOOFDCYCLUS
1520 REM
1530 GOSUB100
1540 SR$="A D R E S B E S T A N D":GOSUB10130
1550 PRINT:PRINT
1560 PRINT"Uw keuzemogelijkheden:"
1570 PRINT:PRINT
1580 PRINT:PRINT"1  Oud bestand inlezen"
1590 PRINT:PRINT"2  Bestand raadplegen/muteren"
1600 PRINT:PRINT"3  Bestand wegschrijven"
1610 PRINT:PRINT"4  Einde programma"
1620 MK=5:GOSUB1830
1630 GOSUB100
1640 ONKZ GOTO2030,3030,7030,9030,8030
1800 REM
1810 REM  KEUZE-OPVRAGEN-SUBROUTINE
1820 REM
1830 HO=0:VE=VT-1:GOSUB110
1840 PRINT"Wat is uw keuze      ";
1850 HO=17:VE=VT-1:GOSUB110
1860 INPUTKZ$:KZ=VAL(KZ$)
1870 IF(KZ<1)OR(KZ>MK)OR(KZ<>INT(KZ))THEN GOSUB250:GOTO1830
1880 RETURN
2000 REM
2010 REM  MENUKEUZE 1=OUD BESTAND INLEZEN
2020 REM
2030 SR$="OUD BESTAND INLEZEN":GOSUB10130
2040 PRINT:PRINT
2050 PRINT"U kunt inlezen van:"
2060 PRINT:PRINT
2070 PRINT:PRINT"1  BASICODE-3 cassette"
2080 PRINT:PRINT"2  cassette van uw eigen computer"
2090 PRINT:PRINT"3  diskette van uw eigen computer"
2100 PRINT:PRINT"4  Toch geen bestand inlezen"
2110 MK=4:GOSUB1830
2120 IFKZ=4 THEN1530
2130 NF=2*KZ-2:NF$="NAWP"
2140 GOSUB500:REM  OPENEN
2150 GOSUB540:AR=VAL(IN$):REM  INVOER AANTAL RECS
2160 GOSUB540:MV=VAL(IN$):REM  INVOER AANTAL VELDEN
2170 GOSUB540:VS=VAL(IN$):REM  INVOER SORTEERVELD
2180 HO=0:VE=VT-1
2190 FORJ=0 TOMV
2200 GOSUB540:DE$(J)=IN$
2210 FORI=1 TOAR
2220 GOSUB110:PRINT"Veld ";:SR=J:GOSUB300
2230 PRINTSR$;", Record ";:SR=I:GOSUB300
2240 PRINTSR$;"    ";
2250 GOSUB540:BE$(I,J)=IN$
2260 NEXTI
2270 NEXTJ
2280 GOSUB580:REM  SLUIT BESTAND
2290 NU=1
2300 GOTO1530
3000 REM
3010 REM  MENUKEUZE 2 = BESTAND RAADPLEGEN/MUTEREN
3020 REM
3030 GOSUB100
3040 SR$="BESTAND RAADPLEGEN / MUTEREN":GOSUB10130
3050 PRINT:PRINT"U hebt nu ";:SR=AR:GOSUB300
3060 PRINTSR$;" records,"
3070 PRINT" gesorteerd op ";DE$(VS)
3080 PRINT:PRINT
3090 PRINT:PRINT"U kunt nu:"
3100 PRINT:PRINT"1  Bladeren in het bestand"
3110 PRINT:PRINT"2  Zoeken naar een ";DE$(VS)
3120 PRINT:PRINT"3  Een nieuw record invoeren"
3130 PRINT:PRINT"4  Bestand opnieuw sorteren"
3140 PRINT:PRINT"5  Terug naar het hoofdmenu"
3150 MK=6:GOSUB1830
3160 IFKZ=5 THEN1530
3170 ONKZ GOSUB3330,4530,5530,6030
3180 IFKZ=2 THEN GOSUB3330
3190 GOTO3030
3300 REM
3310 REM  BLADEREN
3320 REM
3330 IFAR=0 THEN GOSUB250:RETURN
3340 IFNU<1 THENNU=1
3350 IFNU>AR THENNU=AR
3360 GOSUB4030
3370 HO=0:VE=VT-1:GOSUB110
3380 PRINT"(V)ooruit,  (T)erug,  (W)ijzigen,"
3390 PRINT"(P)rinten,  (S)chrappen,  (M)enu";
3400 GOSUB210
3410 IFIN=86 THENNU=NU+1:GOTO3340:REM  V
3420 IFIN=83 THEN3830:REM  S
3430 IFIN=84 THENNU=NU-1:GOTO3340:REM  T
3440 IFIN=80 THENGOSUB3630:GOTO3340:REM P
3450 IFIN=87 THEN5030:REM  W
3460 IFIN=77 THENRETURN:REM  M
3470 GOSUB250:GOTO3400
3600 REM
3610 REM  PRINTEN
3620 REM
3630 GOSUB360
3640 SR=NU:GOSUB300
3650 SR$="Nummer "+SR$:GOSUB350:GOSUB360:GOSUB360
3660 FORJ=0 TOMV
3670 SR$=DE$(J):GOSUB350:SR$=" : ":GOSUB350
3680 SR$=BE$(NU,J):GOSUB350:GOSUB360
3690 NEXTJ:GOSUB360
3700 RETURN
3800 REM
3810 REM  SCHRAPPEN
3820 REM
3830 HO=0:VE=0:GOSUB110
3840 SR$="DIT RECORD SCHRAPPEN":GOSUB10130
3850 VE=VT-1:GOSUB110
3860 SR$="HERHAAL OF HERROEP OPDRACHT":GOSUB10140
3870 GOSUB250:REM  PIEP
3880 VE=VT:GOSUB110
3890 PRINT"   (S)chrappen of (B)laderen    ";
3900 GOSUB210
3910 IFIN<>83 THEN3340:REM  <>S
3920 FORI=NU TOAR-1
3930 FORJ=0 TOMV:BE$(I,J)=BE$(I+1,J):NEXTJ
3940 NEXTI
3950 AR=AR-1
3960 GOTO3340
4000 REM
4010 REM  PRINT RECORD(NU)
4020 REM
4030 GOSUB100
4040 PRINT"RECORD NUMMER ";NU
4050 PRINT
4060 FORJ=0 TOMV
4070 HO=0:VE=5+3*J:GOSUB110:PRINTDE$(J)
4080 HO=10:GOSUB110:PRINT": ";BE$(NU,J)
4090 NEXTJ
4100 RETURN
4500 REM
4510 REM  ZOEKEN
4520 REM
4530 GOSUB100
4540 PRINT"Welke ";DE$(VS);" wilt u "
4550 PRINT"    ";:INPUTZ$
4560 GOSUB4610
4570 RETURN
4580 REM
4590 REM  ZOEKROUTINE Z$
4600 REM
4610 PRINT:PRINT"Even geduld a.u.b.";
4620 V1=1:V2=AR+1
4630 V3=INT((V1+V2)/2)
4640 PRINT".";
4650 IFBE$(V3,VS)>Z$ THENV2=V3:GOTO4670
4660 V1=V3
4670 IFV2>V1+1 THEN4630
4680 NU=V1
4690 RETURN
5000 REM
5010 REM  WIJZIGEN
5020 REM
5030 GOSUB100
5040 SR$="DIT RECORD WIJZIGEN":GOSUB10130
5050 FORJ=0 TOMV
5060 HO=0:VE=3+4*J:GOSUB110
5070 PRINT"De ";DE$(J);" is nu:"
5080 PRINT"   ";BE$(NU,J)
5090 PRINT"Wijzigen (J/N) ";:GOSUB210
5100 IFIN<>74 THEN5140:REM  <>J
5110 VE=VE+2:GOSUB110:PRINTLR$
5120 GOSUB110:PRINT"Nieuwe ";DE$(J);" ";
5130 INPUTBE$(NU,J)
5140 NEXTJ
5150 RETURN
5500 REM
5510 REM  NIEUW RECORD INVOEREN
5520 REM
5530 GOSUB100
5540 IFAR=MR THEN GOSUB250:RETURN
5550 PRINT"NIEUW RECORD INVOEREN"
5560 FORJ=0 TOMV
5570 HO=0:VE=7+J*3:GOSUB110
5580 PRINTDE$(J)
5590 HO=11:GOSUB110:PRINT":";
5600 INPUTRI$(J)
5610 NEXTJ
5620 PRINT:PRINT"Tik op A voor accoord,"
5630 PRINT"    op C voor correctie,"
5640 PRINT"    op V voor 'Vergeet deze invoer'";
5650 GOSUB210
5660 IFIN=86 THENRETURN:REM  V
5670 IFIN=67 THEN5530:REM  C
5680 IFIN<>65 THEN5650:REM  <>A
5690 IFAR=0 THENNU=1:GOTO5750
5700 Z$=RI$(VS):GOSUB4610:REM  ZOEK
5710 NU=NU+1
5720 FORI=AR+1 TONU+1 STEP-1
5730 FORJ=0 TOMV:BE$(I,J)=BE$(I-1,J):NEXTJ
5740 NEXTI
5750 FORJ=0 TOMV:BE$(NU,J)=RI$(J):NEXTJ
5760 AR=AR+1
5770 RETURN
6000 REM
6010 REM  OPNIEUW SORTEREN
6020 REM
6030 GOSUB100
6040 PRINT:PRINT
6050 PRINT"U kunt het bestand laten sorteren op:"
6060 PRINT:PRINT
6070 FORJ=0 TOMV
6080 PRINT:PRINTJ+1;" ";DE$(J)
6090 NEXTJ
6100 MK=MV+1:GOSUB1830
6110 VS=KZ-1:HO=0
6120 GOSUB110:PRINTLR$:VE=VE-4
6130 GOSUB110:PRINT"Ik sorteer op ";DE$(VS)
6140 PRINT"Ogenblikje ...";
6500 REM
6510 REM  SORTEREN MET QUICKSORT
6520 REM
6530 V1=2:SO(1)=1:SO(21)=AR
6540 V1=V1-1:V2=SO(V1):V3=SO(V1+20)
6550 V4=V2:V5=V3:V6$=BE$(.5*(V2+V3),VS)
6560 IFBE$(V4,VS)<V6$ THENV4=V4+1:GOTO6560
6570 IFBE$(V5,VS)>V6$ THENV5=V5-1:GOTO6570
6580 IFV4<=V5 THEN GOSUB6660:V4=V4+1:V5=V5-1
6590 IFV4<=V5 THEN6560
6600 IFV4<V3 THENSO(V1)=V4:SO(V1+20)=V3:V1=V1+1
6610 V3=V5:IFV2<V3 THEN6550
6620 IFV1>1 THEN6540
6630 PRINT:PRINT"Gesorteerd op ";DE$(VS)
6640 GOSUB10030
6650 RETURN
6660 FORJ=0 TOMV
6670 H$=BE$(V4,J):BE$(V4,J)=BE$(V5,J):BE$(V5,J)=H$
6680 NEXTJ
6690 RETURN
7000 REM
7010 REM  MENUKEUZE 3 = BESTAND WEGSCHRIJVEN
7020 REM
7030 SR$="BESTAND WEGSCHRIJVEN":GOSUB10130
7040 PRINT:PRINT
7050 PRINT"U kunt wegschrijven naar:"
7060 PRINT:PRINT
7070 PRINT:PRINT"1  BASICODE-3 cassette"
7080 PRINT:PRINT"2  cassette van uw eigen computer"
7090 PRINT:PRINT"3  diskette van uw eigen computer"
7100 PRINT:PRINT"4  Toch geen bestand wegschrijven"
7110 MK=4:GOSUB1830
7120 IFKZ=4 THEN1530
7130 NF=2*KZ-1:NF$="NAWP"
7140 GOSUB500:REM  OPENEN
7150 SR=AR:GOSUB300:GOSUB560
7160 SR=MV:GOSUB300:GOSUB560
7170 SR=VS:GOSUB300:GOSUB560
7180 HO=0:VE=VT-1
7190 FORJ=0 TOMV
7200 SR$=DE$(J):GOSUB560
7210 FORI=1 TOAR
7220 GOSUB110:PRINT"Veld ";:SR=J:GOSUB300
7230 PRINTSR$;", Record ";:SR=I:GOSUB300
7240 PRINTSR$;"    ";
7250 SR$=BE$(I,J):GOSUB560
7260 NEXTI
7270 NEXTJ
7280 GOSUB580:REM  SLUIT BESTAND
7290 GOTO1530
8000 REM
8010 REM  MENUKEUZE 5 = NIEUW BESTAND
8020 REM
8030 GOSUB100
8040 PRINT"Aantal velden (1...5)";
8050 INPUTMV
8060 MV=INT(MV):IF(MV<1)OR(MV>5)THEN GOSUB250:GOTO8040
8070 MV=MV-1:FORJ=0 TOMV
8080 PRINT"Naam veld ";J+1;" ";
8090 INPUTDE$(J)
8100 NEXTJ
8110 GOTO1530
9000 REM
9010 REM  MENUKEUZE 4 = EINDE
9020 REM
9030 GOSUB100
9040 PRINT:PRINT"EINDE PROGRAMMA"
9050 PRINT:PRINT"Weet u het zeker ";
9060 INPUTSR$:GOSUB330
9070 IFSR$<>"JA" THEN1530
9080 GOTO950
10000 REM
10010 REM  WACHTROUTINE
10020 REM
10030 HO=INT((HT-30)/2):VE=VT
10040 SR$="Druk op de spatie voor vervolg"
10050 GOSUB10140
10060 GOSUB210
10070 IFIN$<>" " THEN10060
10080 RETURN
10100 REM
10110 REM  GEACCENTUEERD CENTRAAL
10120 REM
10130 VE=0
10140 HO=0:GOSUB110
10150 FORS=1 TOINT((HT-LEN(SR$))/2-3)
10160 PRINT" ";
10170 NEXTS
10180 GOSUB150
10190 RETURN
25000 DATA3
25010 DATA"Naam","Adres","Woonplaats","Postcode"
30000 REM *****************************
30010 REM
30020 REM   ADRESBESTAND IS EEN
30030 REM   DEMONSTRATIE VAN DE
30040 REM   MOGELIJKHEDEN   VAN
30050 REM   B A S I C O D E - 3
30060 REM
30070 REM
30080 REM   COPYRIGHT (C)
30090 REM   STICHTING  BASICODE
30100 REM             1986,1987
30110 REM
30120 REM ******************************
30130 REM  versie 1.5 dd 871212