500 REM: MECCAN0 VOORRAADADM. - MENU 505 GOSUB 5950:PRINT TAB(5);"M E N U van Voorraadprogramma":GOSUB 6000 510 PRINT:PRINT"Mogelijkheden:":PRINT" 1. Informatie": PRINT" 2. Voorraad aanvullen of afschrijven": PRINT" 3. Entry-bewerkingen (overschrijven,": PRINT" toevoegen, tussenvoegen)" 515 PRINT" 4. Een of meer regels afdrukken" 520 PRINT" 5. Bepaalde entries zoeken": PRINT" 6. Ander bestand binnenhalen": PRINT" 7. Tandwielberekeningen": PRINT" 8. Stoppen" 525 PRINT:PRINT"Geef gewenste nummer: ";:KEUS$=INPUT$(1):PRINT KEUS$: KEUS=VAL(KEUS$):IF KEUS<1 OR KEUS>8 THEN PRINT:PRINT"Foutieve keuze !": GOTO 510 530 IF KEUS=8 THEN GOSUB 6300:END 535 IF KEUS=7 THEN GOSUB 6300:K$="2":GOTO 45 ELSE ON KEUS GOSUB 1000,1500,2000,3000,4000,5000:GOTO 510 1000 REM: INFORMATIE 1005 GOSUB 5950:PRINT TAB(15);"INFORMATIE":PRINT: PRINT"De voorraad-administratie werkt met 3 bestanden:": PRINT" 1. De Standard Meccano Parts (t/m 235G)": PRINT" 2. De Special Meccano Parts (de hogere" 1010 PRINT" nummers, de afwijkende nummers en ongenummerde delen)": PRINT" 3. De Marklin Parts.":PRINT 1015 PRINT"Bij het opstarten van het programma is": PRINT"bestand 1 direct voor gebruik beschik-": PRINT"baar. Het veranderen van bestand gaat":PRINT"via het Menu.":PRINT 1020 PRINT"Voor antwoorden, die nooit meer dan 1": PRINT"teken groot kunnen zijn, behoeft geen": PRINT"RETURN-toets gebruikt te worden. Wanneer": PRINT"de lengte zou kunnen varieren, moet men" 1025 PRINT"echter wel de RETURN-toets gebruiken.":PRINT:PRINT:GOSUB 6800 1030 PRINT"De kleurcode is als volgt:": PRINT:PRINT" 0 = - (onbepaald)";TAB(20);" 7 = black": PRINT" 1 = metal";TAB(20);" 8 = grey": PRINT" 2 = yellow";TAB(20);" 9 = white": PRINT" 3 = blue";TAB(20);"10 = green" 1035 PRINT" 4 = dark blue";TAB(20);"11 = gold": PRINT" 5 = brass";TAB(20);"12 = black + red": PRINT" 6 = red";TAB(20);"13 = black + yellow":PRINT 1040 PRINT"Alle gegevens en antwoorden dient U in hoofdletters te geven." 1045 PRINT:PRINT"Het vullen van de bestanden geschiedt": PRINT"vnl. via keus 2 v.d.'Entry-bewerkingen'": PRINT:PRINT"Overigens is het programma zelf-":PRINT"verklarend." 1050 FOR I=1 TO 4:PRINT:NEXT I:GOSUB 6800:RETURN 1500 REM: VOORRAAD WIJZIGEN 1505 GOSUB 5800: PRINT:PRINT"Mogelijkheden:":PRINT" 1. Voorraad aanvullen": PRINT" 2. Voorraad afschrijven":PRINT" 3. Geen van beide":PRINT: PRINT SPC(15) "Keuzenummer ? "; 1510 VO$=INPUT$(1):PRINT VO$:IF ASC(VO$)<49 OR ASC(VO$)>51 THEN PRINT: PRINT"1, 2 of 3 ?":GOTO 1510 1515 IF VO$="3" THEN RETURN ELSE IF VO$="2" THEN 1700 1600 REM: AANVULLEN 1605 PRINT:INPUT"Welk volgnummer ";VOLG:GOSUB 6100:PRINT:GOSUB 6400:PRINT: INPUT"Hoeveel toevoegen ";T%:Q%=CVI(Q$)+T%:LSET Q$=MKI$(Q%): GOSUB 6200:PRINT:GOSUB 6400 1610 GOSUB 6850:IF ME$="J" THEN 1605 ELSE RETURN 1700 REM: AFSCHRIJVEN 1705 PRINT:INPUT"Welk volgnummer ";VOLG:GOSUB 6100:PRINT:GOSUB 6400 1710 PRINT:INPUT"Hoeveel afschrijven ";S%:Q%=CVI(Q$):IF Q%-S%<0 THEN PRINT: PRINT"De voorraad was maar";Q%:PRINT:GOTO 1710 ELSE Q%=Q%-S%: LSET Q$=MKI$(Q%):GOSUB 6200:PRINT:GOSUB 6400 1715 GOSUB 6850:IF ME$="J" THEN 1705 ELSE RETURN 2000 REM: ENTRY-BEWERKINGEN 2005 GOSUB 5800:PRINT:PRINT"1=Bestaande entry overschrijven": PRINT"2=Nieuwe entry achteraan toevoegen": PRINT"3=Nieuwe entry tussenvoegen": PRINT"4=Abuis ! (terug naar Menu)":PRINT:PRINT SPC(10) "Keuzenummer ? "; 2010 EN$=INPUT$(1):EN=VAL(EN$):PRINT EN:IF EN<1 OR EN>4 THEN PRINT: PRINT"1, 2, 3 of 4 ?":GOTO 2005 2015 IF EN=4 THEN RETURN ELSE ON EN GOTO 2100,2200,2300 2100 REM: BESTAANDE ENTRY OVERSCHRYVEN 2105 PRINT:INPUT"Welk volgnummer ";VOLG:GOSUB 6100:PRINT:GOSUB 6400:PRINT: PRINT"Overschrijven (J/N) ?"; 2110 OV$=INPUT$(1):PRINT OV$:IF OV$<>"J" AND OV$<>"N" THEN PRINT: PRINT"J of N !";:GOTO 2110 2115 PRINT:IF OV$="N" GOTO 2125 2120 GOSUB 6700:GOSUB 6200 2125 PRINT:GOSUB 6850:IF ME$="J" GOTO 2105 ELSE PRINT:RETURN 2200 REM: ENTRY ACHTERAAN TOEVOEGEN 2205 GOSUB 6950:FOR I=1 TO EF:VOLG=I:GOSUB 6100:IF LEFT$(D$,5)="EINDE" GOTO 2215 2210 NEXT I 2215 GOSUB 6700:GOSUB 6200:PRINT:GOSUB 6850 2220 IF ME$="J" THEN PRINT:VOLG=VOLG+1:GOTO 2215 2225 VOLG=VOLG+1:LSET P$="-":LSET D$="EINDE":LSET S$="-": COLR%=0:LSET C$=MKI$(COLR%):Q%=0:LSET Q$=MKI$(Q%):GOSUB 6200:RETURN 2300 REM: ENTRY TUSSENVOEGEN 2305 PRINT:INPUT"Als welk volgnummer ";J:GOSUB 6950:FOR I=EF TO 1 STEP -1: VOLG=I:GOSUB 6100:IF LEFT$(D$,5)="EINDE" THEN K=I+1:GOTO 2315 2310 NEXT I 2315 FOR I=K TO J+1 STEP -1:VOLG=I-1:GOSUB 6100:VOLG=I:GOSUB 6200:NEXT I:PRINT: PRINT"Nu de gegevens voor nieuwe entry:":VOLG=J:GOSUB 6700:GOSUB 6200: PRINT 2320 GOSUB 6850:IF ME$="J" THEN 2305 ELSE RETURN 3000 REM: AFDRUKKEN 3005 GOSUB 5800:PRINT:INPUT"Hoeveel regels afdrukken ";AF:IF AF=1 THEN PRINT: INPUT"Welk volgnummer ";VOLG:PRINT:GOSUB 6100:GOSUB 6400:RETURN 3010 PRINT:INPUT"Vanaf welk volgnummer ";VOLG 3015 GOSUB 6750 3020 GOSUB 5950:IF PR$="J" GOTO 3040 3025 A=VOLG:B=VOLG+AF-1:FOR I=A TO B:P=I-A:VOLG=I:GOSUB 6100: IF P/5=INT(P/5) THEN GOSUB 6400 ELSE GOSUB 6410 3030 P=P+1:IF P/5=INT(P/5) AND P<>(B-A+1) THEN GOSUB 6800 3035 NEXT I:GOSUB 6800:RETURN 3040 A=VOLG:B=VOLG+AF-1:FOR I=A TO B:P=I-A:VOLG=I:GOSUB 6100: IF P/32=INT(P/32) THEN GOSUB 6500 ELSE GOSUB 6510 3045 P=P+1:IF P/32=INT(P/32) THEN FOR J=1 TO 3:LPRINT:NEXT J: REM (J=3 EN P=32 GELDT VOOR PRINTERVELLEN VAN 72 REGELS) 3050 NEXT I:RETURN 4000 REM: ZOEKEN 4005 PRINT:PRINT"Alle bestanden worden doorzocht" 4010 PRINT:PRINT"Zoeken kan:":PRINT" 1. Op part number":PRINT" 2. Op kleur": PRINT" 3. Op omschrijving":PRINT" 4. Abuis ! (terug naar Menu)":PRINT: PRINT SPC(10);"Keuzenummer ? "; 4015 ZO$=INPUT$(1):PRINT ZO$:ZO=VAL(ZO$):IF ZO<1 OR ZO>4 THEN PRINT: PRINT"1, 2, 3 of 4 ? ";:GOTO 4015 4020 GOSUB 6950:IF ZO=4 THEN RETURN 4025 IF FILE<>1 THEN GOSUB 6300:GOSUB 6010:GOSUB 6950 4030 ON ZO GOTO 4100,4200,4300 4100 REM: ZOEKEN OP PART NUMBER 4105 PRINT:INPUT"Geef het betr. part number ";PA$:GOSUB 6750:GOSUB 5950 4110 IF LEN(PA$)<>5 THEN PA$=PA$+" ":GOTO 4110 4115 TEL=0:FOR I=1 TO EF:VOLG=I:GOSUB 6100:IF P$=PA$ THEN IF PR$="J" THEN GOSUB 6500:TEL=TEL+1:GOTO 4130 ELSE GOSUB 6400:TEL=TEL+1:GOTO 4130 4120 IF LEFT$(D$,5)="EINDE" GOTO 4145 4125 NEXT I 4130 FOR J=(I+1) TO EF:VOLG=J:GOSUB 6100:IF P$=PA$ THEN IF PR$="J" THEN GOSUB 6510:TEL=TEL+1 ELSE GOSUB 6410:TEL=TEL+1 4135 IF LEFT$(D$,5)="EINDE" GOTO 4145 4140 NEXT J 4145 IF TEL=0 THEN PRINT:PRINT"Komt niet voor bij de ";TI$:PRINT 4150 GOSUB 6800:GOSUB 5850:IF FILE<>1 GOTO 4115 4155 GOSUB 6850:IF ME$="J" THEN 4005 ELSE RETURN 4200 REM: ZOEKEN OP KLEUR 4205 PRINT:INPUT"Geef codenummer van de kleur ";KL$: IF ASC(KL$)<48 OR ASC(KL$)>57 THEN PRINT"Nummer !!":GOTO 4205 4210 KL%=VAL(KL$):IF KL%<0 OR KL%>13 THEN PRINT "Deze code bestaat niet.":GOTO 4205 4215 GOSUB 6750 4220 GOSUB 5950 4225 TEL=0 4230 FOR I=1 TO EF:VOLG=I:GOSUB 6100:IF KL%=CVI(C$) THEN IF PR$="J" THEN GOSUB 6500:TEL=TEL+1:GOTO 4245 ELSE GOSUB 6400:TEL=TEL+1:GOTO 4245 4235 IF LEFT$(D$,5)="EINDE" GOTO 4275 4240 NEXT I 4245 FOR J=(I+1) TO EF:VOLG=J:GOSUB 6100:IF KL%=CVI(C$) AND PR$="J" AND TEL/32=INT(TEL/32) THEN FOR M=1 TO 3:LPRINT:NEXT M:GOSUB 6500: TEL=TEL+1:GOTO 4270:REM (M=3 EN TEL=32 GELDT VOOR PRINTERVELLEN 72 REGELS) 4250 IF KL%=CVI(C$) AND PR$="J" AND TEL/32<>INT(TEL/32) THEN GOSUB 6510:TEL=TEL+1:GOTO 4270 4255 IF KL%=CVI(C$) AND PR$="N" AND TEL/5=INT(TEL/5) THEN GOSUB 6800: GOSUB 6400:TEL=TEL+1:GOTO 4270 4260 IF KL%=CVI(C$) AND PR$="N" AND TEL/5<>INT(TEL/5) THEN GOSUB 6410:TEL=TEL+1 4265 IF LEFT$(D$,5)="EINDE" GOTO 4275 4270 NEXT J 4275 IF TEL=0 THEN PRINT:PRINT"Komt niet voor bij de ";TI$:PRINT 4280 GOSUB 6800:GOSUB 5850:IF FILE<>1 GOTO 4225 4285 GOSUB 6850:IF ME$="J" THEN 4005 ELSE RETURN 4300 REM: ZOEKEN OP OMSCHRIJVING 4305 PRINT:PRINT"Geef gezochte omschrijving:":INPUT OM$:PRINT:L=LEN(OM$):IF L>30 THEN PRINT"Omschrijving kan maar max.30 tekens zijn":PRINT:GOTO 4305 4310 GOSUB 6750 4315 GOSUB 5950 4320 TEL=0 4325 FOR I=1 TO EF:VOLG=I:GOSUB 6100:IF OM$=LEFT$(D$,L) THEN IF PR$="J" THEN GOSUB 6500:TEL=TEL+1:GOTO 4340 ELSE GOSUB 6400:TEL=TEL+1:GOTO 4340 4330 IF LEFT$(D$,5)="EINDE" GOTO 4370 4335 NEXT I 4340 FOR J=(I+1) TO EF:VOLG=J:GOSUB 6100:IF OM$=LEFT$(D$,L) AND PR$="J" AND TEL/32=INT(TEL/32) THEN FOR M=1 TO 3:LPRINT:NEXT M:GOSUB 6500: TEL=TEL+1:GOTO 4365:REM (M=3 EN TEL=32 GELDT VOOR PRINTERVELLEN 72 REGELS) 4345 IF OM$=LEFT$(D$,L) AND PR$="J" AND TEL/32<>INT(TEL/32) THEN GOSUB 6510:TEL=TEL+1:GOTO 4365 4350 IF OM$=LEFT$(D$,L) AND PR$="N" AND TEL/5=INT(TEL/5) THEN GOSUB 6800: GOSUB 6400:TEL=TEL+1:GOTO 4365 4355 IF OM$=LEFT$(D$,L) AND PR$="N" AND TEL/5<>INT(TEL/5) THEN GOSUB 6410:TEL=TEL+1 4360 IF LEFT$(D$,5)="EINDE" GOTO 4370 4365 NEXT J 4370 IF TEL=0 THEN PRINT:PRINT"Komt niet voor bij de ";TI$:PRINT 4375 GOSUB 6800:GOSUB 5850:IF FILE<>1 GOTO 4320 4380 GOSUB 6850:IF ME$="J" THEN 4005 ELSE RETURN 5000 REM: ANDER BESTAND BINNENHALEN 5005 PRINT:PRINT"Momenteel is bestand";FILE;"in bedrijf." 5010 PRINT:PRINT"De bestandenden zijn:":PRINT" 1. De Standard Parts": PRINT" 2. De Special Parts":PRINT" 3. De Marklin Parts": PRINT" 4. Abuis ! (terug naar Menu)":PRINT:PRINT SPC(10);"Keuzenummer ? "; 5015 FI$=INPUT$(1):PRINT FI$:IF ASC(FI$)<49 OR ASC(FI$)>52 THEN PRINT: PRINT"1, 2, 3 of 4 ! ";:GOTO 5015 5020 IF FI$="4" THEN PRINT:PRINT"Bestand";FILE;"blijft in bedrijf !":RETURN 5025 GOSUB 6300:IF FI$="1" THEN GOSUB 6010:GOTO 5040 5030 IF FI$="2" THEN GOSUB 6015:GOTO 5040 5035 IF FI$="3" THEN GOSUB 6020: 5040 PRINT:PRINT"Bestand";FILE;"is nu in bedrijf.":RETURN 5700 REM: ROUTINE-BLOK 5800 REM: WELK BESTAND? 5805 PRINT:PRINT"U werkt nu met de ";TI$:RETURN 5850 REM: FILE WISSELEN BIJ ZOEKEN 5855 IF FILE=1 THEN GOSUB 6300:GOSUB 6015:GOSUB 6950:RETURN 5860 IF FILE=2 THEN GOSUB 6300:GOSUB 6020:GOSUB 6950:RETURN 5865 IF FILE=3 THEN GOSUB 6300:GOSUB 6010:GOSUB 6950:RETURN 5950 REM: SCHERM SCHOON CURSOR HOME 5955 PRINT CHR$(12);:RETURN 6000 REM: FILES OPENEN 6010 OPEN"R",#1,"STANDARD.DAT",46: FIELD#1,5 AS P$,30 AS D$,7 AS S$,2 AS C$,2 AS Q$: FILE=1:TI$="Standard Parts":RETURN 6015 OPEN"R",#2,"SPECIALS.DAT",46: FIELD#2,5 AS P$,30 AS D$,7 AS S$,2 AS C$,2 AS Q$: FILE=2:TI$="Special Parts":RETURN 6020 OPEN"R",#3,"MARKLIN.DAT",46: FIELD#3,5 AS P$,30 AS D$,7 AS S$,2 AS C$,2 AS Q$: FILE=3:TI$="Marklin Parts":RETURN 6100 REM: ENTRY OPHALEN 6105 IF FILE=1 THEN GET#1,VOLG:RETURN 6110 IF FILE=2 THEN GET#2,VOLG:RETURN 6115 IF FILE=3 THEN GET#3,VOLG:RETURN 6200 REM: ENTRY NAAR FILE STUREN 6205 IF FILE=1 THEN PUT#1,VOLG:RETURN 6210 IF FILE=2 THEN PUT#2,VOLG:RETURN 6215 IF FILE=3 THEN PUT#3,VOLG:RETURN 6300 REM: FILES SLUITEN 6305 IF FILE=1 THEN CLOSE#1:RETURN 6310 IF FILE=2 THEN CLOSE#2:RETURN 6315 IF FILE=3 THEN CLOSE#3:RETURN 6400 REM: AFDRUKKEN OP SCHERM 6405 PRINT TI$:PRINT:PRINT"VOLGNR PARTNR KLEUR AANTAL": PRINT" OMSCHRIJVING";SPC(14);"MAAT(inches)":PRINT 6410 PRINT USING "#####";VOLG;:PRINT" ";P$;" ";:GOSUB 6600:PRINT COLR$;: PRINT TAB(27);USING"####";CVI(Q$):PRINT"= ";D$;" ";S$:PRINT:RETURN 6500 REM: AFDRUKKEN OP PRINTER 6505 WIDTH 80:GOSUB 6900:LPRINT: LPRINT"VOLGNR PART OMSCHRIJVING";SPC(19);"MAAT KLEUR AANTAL": LPRINT TAB(9);"NR";TAB(45);"inches":LPRINT 6510 WIDTH 80: LPRINT USING "#####";VOLG;:LPRINT" ";P$;TAB(14);D$;TAB(45);S$;: GOSUB 6600:LPRINT TAB(53);COLR$;TAB(61);USING"####";CVI(Q$):LPRINT: WIDTH 40:RETURN 6600 REM: KLEURCODE VERTALEN 6605 IF CVI(C$)=1 THEN COLR$="METAL":RETURN 6610 IF CVI(C$)=2 THEN COLR$="YELLOW":RETURN 6615 IF CVI(C$)=3 THEN COLR$="BLUE":RETURN 6620 IF CVI(C$)=4 THEN COLR$="D.BLUE":RETURN 6625 IF CVI(C$)=5 THEN COLR$="BRASS":RETURN 6630 IF CVI(C$)=6 THEN COLR$="RED":RETURN 6635 IF CVI(C$)=7 THEN COLR$="BLACK":RETURN 6640 IF CVI(C$)=8 THEN COLR$="GREY":RETURN 6645 IF CVI(C$)=9 THEN COLR$="WHITE":RETURN 6650 IF CVI(C$)=10 THEN COLR$="GREEN":RETURN 6655 IF CVI(C$)=11 THEN COLR$="GOLD":RETURN 6660 IF CVI(C$)=12 THEN COLR$="BLACK+R":RETURN 6665 IF CVI(C$)=13 THEN COLR$="BLACK+Y":RETURN 6670 COLR$="-":RETURN 6700 REM: INPUT VOOR ENTRY 6705 PRINT:PRINT"Volgnr.";VOLG: INPUT"Part number ";PART$:LSET P$=PART$: INPUT"Omschrijving ";DESC$:LSET D$=DESC$: INPUT"Maat (in inches) ";SIZE$:LSET S$=SIZE$: INPUT"Kleur code ";COLR%:LSET C$=MKI$(COLR%) 6710 INPUT"Aantal ";Q%:LSET Q$=MKI$(Q%):RETURN 6750 REM: OP PRINTER? 6755 PRINT:PRINT"Resultaat op printer (J/N) ? "; 6760 PR$=INPUT$(1):PRINT PR$:IF PR$<>"J" AND PR$<>"N" THEN PRINT: PRINT"J of N ! ";:GOTO 6760 6765 RETURN 6800 REM: VERDERGAAN? 6805 PRINT:PRINT"Verdergaan ? (Druk willekeurige toets)";: VE$=INPUT$(1):GOSUB 5950:RETURN 6850 REM: NOG MEER? 6855 PRINT:PRINT"Nog meer (J/N) ? "; 6860 ME$=INPUT$(1):PRINT ME$: IF ME$<>"J" AND ME$<>"N" THEN PRINT:PRINT"J of N svp ! ";:GOTO 6860 6865 RETURN 6900 REM: PAGE TITEL (CHR$(14) IS VOOR BREDE LETTERS OP PRINTER, EVTL.AANPASSEN) 6905 IF FILE=1 THEN LPRINT CHR$(14) TAB(10) "Standard Parts": RETURN 6910 IF FILE=2 THEN LPRINT CHR$(14) TAB(10) "Special Parts": RETURN 6915 IF FILE=3 THEN LPRINT CHR$(14) TAB(10) "Marklin Parts": RETURN 6950 REM: END OF FILE (AANPASSEN INDIEN MEN KLEINERE OF GROTERE BESTANDEN WENST MAAR ALTIJD IETS MEER VOOR DUMMY-RECORD 'EINDE' EN TOEVOEGMOGELIJKHEDEN VAN PROGRAMMA) 6955 IF FILE=1 THEN EF=525:RETURN 6960 IF FILE=2 THEN EF=160:RETURN 6965 IF FILE=3 THEN EF=140:RETURN 7000 REM * PROGRAMMA VAN HERMINE BAKKER, UTRECHT 1983 * 0 IF FILE=2 THEN EF=160:RETURN 6965 IF FILE=3 THEN EF=140:RETURN 7000 REM * PROGRAMMA VAN HERMINE BAKKE