Sharp PC1360 |
Dokumentation ansehen
Programmspeicher-Image laden
Setzen Sie in Zeile 1130 Ihre eigene Absenderadresse ein! Achtung: Das P am Beginn der Adresse muss stehen bleiben!
| 10 | AUTOGOTO 20 |
| 20 | "A" CLS :WAIT 0 |
| 30 | IF C2=0 GOSUB 7430 |
| 40 | IF FP GOTO 6000 |
| 50 | IF F6 OR F7 OR G7 OR H7 GOTO 3410 |
| 60 | IF F1=0 OR F2=0 GOTO 3950 |
| 70 | RESTORE 100 |
| 80 | GOTO 7290 |
| 100 | DATA 1,"MENU",5,"Suchen",620,"Liste",1860,"Pflege",2410 |
| 110 | DATA "Optionen",4890,"Transfer",3950,"ENDE",120 |
| 120 | PRINT "Adressdatenbank beendet,":PRINT "Neustart mit ";CHR$ 91;"DEF";CHR$ 93;" ";CHR$ 91; |
| 130 | PRINT "A";CHR$ 93;" !" |
| 140 | GOSUB 6300 :WAIT :CLS |
| 150 | END |
| 160 | PRINT "Datenbankzugang verwehrt":END |
| 170 | RESTORE 190 :GOTO 7290 |
| 190 | DATA 1,"SUCHE",2,"Nachname",210,"Vorname",220,"Geburtstag",360 |
| 210 | PRINT "Nachname:":L=0:GOTO 230 |
| 220 | PRINT "Vorname:":L=1 |
| 230 | M$(0)="A":INPUT M$(0) |
| 240 | IF LEN M$(0)<4 LET M$(0)=M$(0)+"aa" |
| 250 | GOSUB 6490 :IF F5 GOTO 230 |
| 260 | POKE 12348,16:CLEAR A:B=G |
| 270 | P=S(0,L):IF M$(0)<D$(P,L) LET R=0:RETURN |
| 280 | R=INT((A+B)/2) |
| 290 | P=S(R,L) |
| 300 | IF D$(P,L)=M$(0) GOTO 340 |
| 310 | IF B-A=1 LET R=R+1:P=S(R,L):RETURN |
| 320 | IF D$(P,L)<M$(0) LET A=R:GOTO 280 |
| 330 | B=R:GOTO 280 |
| 340 | IF R IF D$(S(R-1,L),L)=M$(0) LET R=R-1:P=S(R,L):GOTO 340 |
| 350 | RETURN |
| 360 | PRINT "Geburtstag:":INPUT M$(0) |
| 370 | L=2:CLEAR A:B=G:IF M$(0)="" CLEAR U,V:GOTO 400 |
| 380 | U=VAL LEFT$ (M$(0),2):V=VAL MID$ (M$(0),4,2):W=1900:GOSUB 490 |
| 390 | IF F5 GOSUB 6510 :GOTO 360 |
| 400 | W=U+V*31 |
| 410 | P=S(0,2):IF W<VAL LEFT$ (D$(P,5),2)+31*VAL MID$ (D$(P,5),4,2) LET R=0:RETURN |
| 420 | R=INT ((A+B)/2):P=S(R,2):H=VAL LEFT$ (D$(P,5),2)+31*VAL MID$ (D$(P,5),4,2) |
| 430 | IF H=W GOTO 470 |
| 440 | IF B-A=1 LET R=R+1:P=S(R,L):RETURN |
| 450 | IF H<W LET A=R:GOTO 420 |
| 460 | B=R:GOTO 420 |
| 470 | IF R LET H=S(R-1,2):IF VAL LEFT$ (D$(H,5),2)+31*VAL MID$ (D$(H,5),4,2)=W LET P=H:R=R-1:GOTO 470 |
| 480 | RETURN |
| 490 | CLEAR F5:IF U<1 OR U>31 OR V<1 OR V>12 OR W<1890 OR W>1999 LET F5=1:GOTO 520 |
| 500 | IF (V=4 OR V=6 OR V=9 OR V=11) AND U>30 LET F5=1:GOTO 520 |
| 510 | IF V=2 AND U>29 LET F5=1 |
| 520 | RETURN |
| 530 | RESTORE 550 :GOTO 7290 |
| 550 | DATA 1,LEFT$ (D$(P,1)+" "+D$(P,0),24),2,"o.k.",610 |
| 560 | DATA "weiter",570,"zurueck",590 |
| 570 | R=R+1:IF R>G BEEP 1,255,100:R=G |
| 580 | P=S(R,L):GOTO 530 |
| 590 | R=R-1:IF -R CLEAR R:BEEP 1,255,100 |
| 600 | P=S(R,L):GOTO 530 |
| 610 | RETURN |
| 620 | IF F1=0 BEEP 1,255,100:PRINT "Keine Datei !":GOSUB 6300 :GOTO 40 |
| 625 | GOSUB 170 :GOSUB 530 :P=S(R,L) |
| 630 | RESTORE 650 :GOTO 7290 |
| 650 | DATA 1,LEFT$ (D$(P,1)+" "+D$(P,0),24),3,"Anzeigen",680,"Drucken",770 |
| 660 | DATA "Blaettern",670,"MENU",70 |
| 670 | GOSUB 530 :GOTO 630 |
| 680 | GOSUB 690 :GOTO 630 |
| 690 | F4=LEN (D$(P,0)+D$(P,1))<24 |
| 700 | IF F4 PRINT D$(P,1);" ";D$(P,0):GOTO 720 |
| 710 | PRINT D$(P,1):PRINT D$(P,0) |
| 720 | PRINT D$(P,2):IF F4=0 WAIT |
| 730 | PRINT D$(P,3):IF F4=0 WAIT 0:GOTO 750 |
| 740 | IF F4 GOSUB 6300 |
| 750 | WAIT 0:CLS :FOR W=4 TO 6:PRINT D$(P,W):NEXT W:GOSUB 6300 |
| 760 | RETURN |
| 770 | GOSUB 6310 :ON C1 GOTO 780 ,820 ,680 |
| 780 | RESTORE 800 :GOTO 7290 |
| 800 | DATA 1,"DRUCK AUF CE-140P",3,"Datensatz",820,"Briefkopf",870,"Grafik" |
| 810 | DATA 1200,"MENU",70 |
| 820 | PRINT "Datensatz wird gedruckt |
| 830 | GOSUB 840 :GOTO 70 |
| 840 | IF LEN (D$(P,0)+D$(P,1))<24+(C1=1)*15 LPRINT D$(P,1)+" "+D$(P,0):GOTO 860 |
| 850 | LPRINT D$(P,1):LPRINT D$(P,0) |
| 860 | FOR I=2 TO 6:LPRINT D$(P,I):NEXT I:LPRINT :RETURN |
| 870 | GRAPH |
| 880 | LLINE (60,0)-(480,0)-(480,-200)-(60,-200)-(60,0) |
| 890 | LLINE (0,-285)-(20,-285):LLINE (85,-40)-(460,-40),1 |
| 900 | GLCURSOR (85,-90):CONSOLE 31:RESTORE 920 :GOTO 7290 |
| 920 | DATA 1,"erste Zeile:",5,"An",940,"Herr",940,"Frau",940,"Fraeulein" |
| 930 | DATA 940,"Firma",940,"<eingeben>",1000 |
| 940 | ON K+1 GOTO 950 ,960 ,970 ,980 ,990 |
| 950 | LPRINT "PAn":GOTO 1010 |
| 960 | LPRINT "PHerr":GOTO 1010 |
| 970 | LPRINT "PFrau":GOTO 1010 |
| 980 | LPRINT "PFraeulein":GOTO 1010 |
| 990 | LPRINT "PFirma":GOTO 1010 |
| 1000 | GOSUB 6420 :LPRINT "P";LEFT$ (T$(0),31) |
| 1010 | GLCURSOR (85,-114) |
| 1020 | IF LEN (D$(P,0)+D$(P,1))>30 LPRINT "P";LEFT$ (D$(P,1),1);". ":GOTO 1040 |
| 1030 | LPRINT "P";D$(P,1);" " |
| 1040 | LPRINT "P";D$(P,0) |
| 1050 | GLCURSOR (85,-138):LPRINT "P";D$(P,2) |
| 1060 | GLCURSOR (85,-162):LPRINT "P";D$(P,3) |
| 1070 | GLCURSOR (85,-28):CSIZE 1:CONSOLE 62 |
| 1080 | RESTORE 1100 :GOTO 7290 |
| 1100 | DATA 1,"Absender:",2,"M. Janssen",1130,"<suchen>",1140,"<eingeben>" |
| 1110 | DATA 1120 |
| 1120 | GOSUB 6420 :LPRINT "P";T$(0):GOTO 1180 |
| 1130 | LPRINT "PHier die eigene Adresse eingeben":GOTO 1180 |
| 1140 | GOSUB 170 :GOSUB 530 |
| 1150 | IF LEN (D$(P,0)+D$(P,1)+D$(P,2)+D$(P,3))>54 GOTO 1170 |
| 1160 | LPRINT "P";D$(P,1);" " |
| 1170 | LPRINT "P";D$(P,0);" / ";D$(P,2);" / ";D$(P,3) |
| 1180 | GLCURSOR (0,-360):LPRINT CHR$ 27+"@" |
| 1190 | GOTO 70 |
| 1200 | GRAPH :CROTATE 1:GLCURSOR (480,0):SORGN :CLEAR GX,GY,G1,G2,G3,Z,G4 |
| 1210 | RESTORE 1230 :GOTO 7290 |
| 1230 | DATA 1,"GRAFIK",8,"Zeile",1290,"Druck",1440,"Farbe",1260,"Typ" |
| 1240 | DATA 1370,"Unter.",1810,"Zeigen",1270,"Suchen",1740,"RAHMEN",1750,"MENU |
| 1250 | DATA 1660 |
| 1260 | GOSUB 1680 :GOTO 1210 |
| 1270 | GLCURSOR (-GY,-Z-100):GOSUB 6300 :GLCURSOR (-GY,-GX) |
| 1280 | GOTO 1210 |
| 1290 | GX=0:RESTORE 1310 :GOTO 7290 |
| 1310 | DATA 1,"ZEILE",8,"2.4mm",1340,"4.8mm",1340,"7.2mm",1340 |
| 1320 | DATA " 9.6mm",1340,"12.0mm",1340,"14.4mm",1340,"16.8mm",1340,"19.2mm" |
| 1330 | DATA 1340,"GRAFIK",1210 |
| 1340 | CSIZE K+1:GY=GY+12*K+20 |
| 1350 | GLCURSOR (-GY,0):G2=K+1 |
| 1360 | GOTO 1210 |
| 1370 | RESTORE 1390 :GOTO 7290 |
| 1390 | DATA 1,"SCHRIFT",2,"normal",1410,"g e s p e r r t",1420,"sscchhaatteenn |
| 1400 | DATA 1430 |
| 1410 | G1=0:GOTO 1210 |
| 1420 | G1=1:GOTO 1210 |
| 1430 | G1=2:GOTO 1210 |
| 1440 | IF GY=0BEEP 1,255,100:GOTO 1290 |
| 1450 | RESTORE 1470 :GOTO 7290 |
| 1470 | DATA 0,7,"Name",1490,"Vorname",1490,"Strasse",1490,"Ort",1490,"Telefon |
| 1480 | DATA 1490,"Geb.dat.",1490,"Bemerkung",1490,"<Text>",1500 |
| 1490 | T$(0)=D$(P,K)+" ":GOTO 1510 |
| 1500 | GOSUB 6420 |
| 1510 | A=GX,B=GY+2*G2 |
| 1520 | FOR I=1 TO LEN T$(0) |
| 1530 | IF G3 COLOR RND 7-1,7 |
| 1540 | LPRINT "P"+MID$ (T$(0),I,1) |
| 1550 | IF G3 COLOR RND 7-1,7 |
| 1560 | IF G1=2 GLCURSOR (-GY+G2,-GX-G2):LPRINT "P"+MID$ (T$(0),I,1) |
| 1570 | GX=GX+G2*6:IF G1=1 LET GX=GX+G2*6 |
| 1580 | GLCURSOR (-GY,-GX) |
| 1590 | NEXT I |
| 1600 | IF GX>Z LET Z=GX |
| 1610 | IF G3 COLOR RND 7-1,7 |
| 1620 | ON G4+1 GOTO 1640 ,1630 ,1630 ,1650 |
| 1630 | LLINE (-B,-GX)-(-B,-A),NOT (G4-1)+2 |
| 1640 | GLCURSOR (-GY,-GX):GOTO 1210 |
| 1650 | LLINE (-B,-GX)-(-B,-A),0:LLINE (-B-5,-A)-(-B-5,-GX):GLCURSOR (-GY,-GX):GOTO 1210 |
| 1660 | GLCURSOR (-480,-Z-100):LPRINT CHR$ 27+"@" |
| 1670 | GOTO 70 |
| 1680 | RESTORE 1700 :GOTO 7290 |
| 1700 | DATA 0,7,"Schwarz",1720,"Violett",1720,"Rot",1720,"Rosa",1720,"Gruen" |
| 1710 | DATA 1720,"Blau",1720,"Gelb",1720,"bunt/ohne",1730 |
| 1720 | G3=0:COLOR K,7:RETURN |
| 1730 | G3=1:RETURN |
| 1740 | GOSUB 170 :GOSUB 530 :GOTO 1210 |
| 1750 | GOSUB 1680 :LLINE (-GY-20,-Z)-(0,18),0,K,B:POKE &FB20,0 |
| 1760 | RESTORE 1780 :GOTO 7290 |
| 1780 | DATA 1,"Hintergrund ausfuellen ?",1,"nein",1660,"ja",1790 |
| 1790 | GOSUB 1680 |
| 1800 | PAINT 9:GOTO 1660 |
| 1810 | RESTORE 1830 :GOTO 7290 |
| 1830 | DATA 1,"UNTERSTREICHEN",3,"nein",1850,"punktiert",1850,"einfach",1850 |
| 1840 | DATA "doppelt",1850 |
| 1850 | G4=K:GOTO 1210 |
| 1860 | IF F1=0 BEEP 1,255,100:PRINT "Keine Datei !":GOSUB 6300 :GOTO 40 |
| 1870 | RESTORE 1880 :GOTO 7290 |
| 1880 | DATA 1,"LISTE",3,"Namen",1900,"Vornamen",1900,"Geb.tage |
| 1890 | DATA 2010,"MENU",70 |
| 1900 | L=K:M$(0)="Aaa":INPUT "von: ";M$(0) |
| 1910 | IF LEN M$(0)<3LET M$(0)=M$(0)+"aa" |
| 1920 | CURSOR 5,0:PRINT M$(0) |
| 1930 | GOSUB 260 :C=R |
| 1940 | IF D$(P,L)<M$(0) GOSUB 6290 :GOTO 40 |
| 1950 | M$(0)="Zzz":INPUT "bis: ";M$(0) |
| 1960 | CURSOR 5,1:PRINT M$(0) |
| 1970 | IF D$(P,L)>M$(0) GOSUB 6290 :GOTO 40 |
| 1980 | GOSUB 260 |
| 1990 | IF D$(P,L)>M$(0) LET R=R-1:P=S(R,L) |
| 2000 | GOTO 2100 |
| 2010 | L=2:M$(0)="01.01.":INPUT "von: ";M$(0) |
| 2020 | CURSOR 5,0:PRINT M$(0) |
| 2030 | GOSUB 370 :C=R |
| 2040 | IF U+V*31<VAL LEFT$ (M$(0),2)+VAL MID$ (M$(0),4,2)*31 GOSUB 6290 :GOTO 40 |
| 2050 | M$(0)="31.12.":INPUT "bis: ";M$(0) |
| 2060 | CURSOR 5,1:PRINT M$(0) |
| 2070 | IF U+V*31>VAL LEFT$ (M$(0),2)+VAL MID$ (M$(0),4,2)*31 GOSUB 6290 :GOTO 40 |
| 2080 | GOSUB 370 |
| 2090 | IF U+V*31<VAL LEFT$ (D$(P,5),2)+VAL MID$ (D$(P,5),4,2)*31 LET R=R-1:P=S(R,L) |
| 2100 | GOSUB 6310 |
| 2110 | RESTORE 2130 :GOTO 7290 |
| 2130 | DATA 1,"FORMAT",2,"komplette Datensaetze",2150 |
| 2140 | DATA "Geb.dat./Name/Vorname",2160,"lfd.Nr./Name/Vorname",2240 |
| 2150 | FOR J=C TO R:P=S(J,L):ON C1 GOSUB 840 ,840 ,690 :NEXT J:GOTO 70 |
| 2160 | IF C1<>3 PRINT =LPRINT :PRINT " " |
| 2170 | FOR J=C TO R:P=S(J,L):PRINT D$(P,5) |
| 2180 | IF LEN (D$(P,1)+D$(P,0))<24PRINT D$(P,1)+" "+D$(P,0):GOTO 2200 |
| 2190 | PRINT D$(P,1):PRINT D$(P,0) |
| 2200 | IF C1=3 GOSUB 6300 :GOTO 2220 |
| 2210 | PRINT " " |
| 2220 | NEXT J |
| 2230 | PRINT =PRINT :GOTO 70 |
| 2240 | IF C1<>3 PRINT =LPRINT :PRINT " " |
| 2250 | W=SGN L |
| 2260 | CLEAR U,V:FOR J=C TO R:P=S(J,L):USING "####" |
| 2270 | T=J-C+1 |
| 2280 | IF LEN D$(P,W)<19+15*(C1=1) GOTO 2310 |
| 2290 | IF V<>INT V AND C1=3 GOSUB 6300 :U=U-INT ((V-INT V+2E-10)*3) |
| 2300 | PRINT T;") ":USING :PRINT D$(P,W):PRINT D$(P,NOT W+2):U=U+2:GOTO 2370 |
| 2310 | IF LEN (D$(P,0)+D$(P,1))<18+15*(C1=1) GOTO 2350 |
| 2320 | IF V<>INT V AND C1=3 GOSUB 6300 :U=U-INT ((V-INT V+2E-10)*3) |
| 2330 | PRINT T;") "; |
| 2340 | USING :PRINT D$(P,W):PRINT " ";D$(P,NOT W+2):U=U+1:GOTO 2370 |
| 2350 | PRINT T;") "; |
| 2360 | USING :PRINT D$(P,W);" ";D$(P,NOT W+2) |
| 2370 | V=(T+U)/3 |
| 2380 | IF V=INT V OR J=R AND C1=3 GOSUB 6300 |
| 2390 | NEXT J |
| 2400 | PRINT =PRINT :GOTO 70 |
| 2410 | IF F1=0 BEEP 1,255,100:PRINT "Keine Datei !":GOSUB 6300 :GOTO 40 |
| 2420 | RESTORE 2430 :GOTO 7290 |
| 2430 | DATA 1,"PFLEGE",5,"Satz dazu",2450,"Datei neu",7450,"Aenderung",2750 |
| 2440 | DATA "Loeschen",3190,"Sortieren",3410,"MENU",70 |
| 2450 | IF G=M PRINT "Speicher voll !":GOSUB 6300 :GOTO 70 |
| 2460 | G=G+1:F6=F6+1:CLEAR F2 |
| 2470 | M$(0)="":PRINT "Name:":INPUT M$(0) |
| 2480 | GOSUB 6490 :IF F5 GOTO 2470 |
| 2490 | D$(G,0)=M$(0) |
| 2500 | M$(0)="":PRINT "Vorname:":INPUT M$(0) |
| 2510 | CLS :IF M$(0)="" GOTO 2530 |
| 2520 | GOSUB 6490 :IF F5 GOTO 2500 |
| 2530 | D$(G,1)=M$(0) |
| 2540 | M$(0)="":PRINT "Strasse:":INPUT M$(0) |
| 2550 | GOSUB 6490 :IF F5 GOTO 2540 |
| 2560 | D$(G,2)=M$(0) |
| 2570 | PRINT "PLZ Ort:":INPUT D$(G,3) |
| 2580 | CLS :IF VAL D$(G,3)=0 LET M$(0)=D$(G,3):GOTO 2600 |
| 2590 | M$(0)=RIGHT$ (D$(G,3),(LEN D$(G,3)-LEN STR$ VAL D$(G,3)-1)) |
| 2600 | GOSUB 6490 |
| 2610 | IF F5 GOTO 2570 |
| 2620 | PRINT "Telefon:":INPUT D$(G,4) |
| 2630 | CLS :M$(0)="":PRINT "Geburtsdatum:":INPUT M$(0) |
| 2640 | IF M$(0)="" CLEAR U,V:GOTO 2710 |
| 2650 | CLEAR F5:IF LEN M$(0)<>10 LET F5=1:GOTO 2690 |
| 2660 | U=VAL LEFT$ (M$(0),2):V=VAL MID$ (M$(0),4,2):W=VAL RIGHT$ (M$(0),4) |
| 2670 | GOSUB 490 |
| 2680 | IF V=2 AND (W/4<>INT (W/4)OR W/400=INT (W/400)) AND U>28 LET F5=1 |
| 2690 | GOSUB 6510 :IF F5 GOTO 2630 |
| 2700 | D$(G,5)=M$(0) |
| 2710 | CLS :PRINT "Bemerkung:":INPUT D$(G,6) |
| 2720 | POKE 12348,16:CLS :P=G |
| 2730 | PRINT "Kontrollausgabe:":GOSUB 6300 |
| 2740 | GOSUB 690 :RESTORE 2745 :GOTO 7290 |
| 2745 | DATA 1,"Datensatz",1,"o.k.",2410,"aendern",2770 |
| 2750 | PRINT "Zu aendernder Datensatz:":GOSUB 6300 |
| 2760 | GOSUB 170 :GOSUB 530 |
| 2770 | PRINT "alter Name:":PRINT D$(P,0):PRINT "neuer Name:" |
| 2780 | M$(0)=D$(P,0):INPUT M$(0) |
| 2790 | CLS :POKE 12348,16:IF M$(0)=D$(P,0) GOTO 2820 |
| 2800 | GOSUB 6490 :IF F5 GOTO 2770 |
| 2810 | F2=0:F7=1:D$(P,0)=M$(0) |
| 2820 | PRINT "alter Vorname:":PRINT D$(P,1):PRINT "neuer Vorname:" |
| 2830 | M$(0)=D$(P,1):INPUT M$(0) |
| 2840 | CLS :POKE 12348,16:IF M$(0)=D$(P,1) GOTO 2870 |
| 2850 | GOSUB 6490 :IF F5 GOTO 2820 |
| 2860 | F2=0:G7=1:D$(P,1)=M$(0) |
| 2870 | PRINT "alte Strasse:":PRINT D$(P,2):PRINT "neue Strasse:" |
| 2880 | M$(0)=D$(P,2):INPUT M$(0) |
| 2890 | CLS :POKE 12348,16:IF M$(0)=D$(P,2) GOTO 2920 |
| 2900 | GOSUB 6490 :IF F5 GOTO 2870 |
| 2910 | F2=0:D$(P,2)=M$(0) |
| 2920 | PRINT "alter Ort:":PRINT D$(P,3):PRINT "neuer Ort:" |
| 2930 | M$(0)=D$(P,3):INPUT M$(0) |
| 2940 | CLS :POKE 12348,16:IF M$(0)=D$(P,3) GOTO 2980 |
| 2950 | F2=0:D$(P,3)=M$(0) |
| 2960 | M$(0)=RIGHT$ (M$(0),LEN M$(0)-LEN STR$ VAL M$(0)-1):GOSUB 6490 |
| 2970 | IF F5 GOTO 2920 |
| 2980 | PRINT "alte Telefonnr.:":PRINT D$(P,4):PRINT "neue Telefonnr.:" |
| 2990 | M$(0)=D$(P,4):INPUT M$(0) |
| 3000 | CLS :IF M$(0)=D$(P,4) GOTO 3020 |
| 3010 | F2=0:D$(P,4)=M$(0) |
| 3020 | PRINT "alter Geburtstag:":PRINT D$(P,5):PRINT "neuer Geburtstag:" |
| 3030 | CLEAR F5:M$(0)=D$(P,5):INPUT M$(0) |
| 3040 | CLS :IF D$(P,5)=M$(0) GOTO 3130 |
| 3050 | IF M$(0)=" " CLEAR U,V:GOTO 3120 |
| 3060 | U=VAL LEFT$ (M$(0),2):V=VAL MID$ (M$(0),4,2):W=VAL RIGHT$ (M$(0),4) |
| 3070 | IF U<1 OR U>31 OR V<1 OR V>12 OR W<1890 OR W>1999 LET F5=1:GOTO 3110 |
| 3080 | IF (V=4 OR V=6 OR V=9 OR V=11)AND U>30 LET F5=1:GOTO 3110 |
| 3090 | IF V=2 AND U>29 LET F5=1:GOTO 3110 |
| 3100 | IF V=2 AND (W/4<>INT (W/4) OR W/400=INT (W/400)) AND U>28 LET F5=1 |
| 3110 | GOSUB 6510 :IF F5 GOTO 3020 |
| 3120 | F2=0:H7=1:D$(P,5)=M$(0) |
| 3130 | PRINT "alte Bemerkung:":PRINT D$(P,6):PRINT "neue Bemerkung:" |
| 3140 | M$(0)=D$(P,6):INPUT M$(0) |
| 3150 | CLS :POKE 12348,16:IF D$(P,6)=M$(0)GOTO 2730 |
| 3160 | F2=0:D$(P,6)=M$(0) |
| 3180 | GOTO 2730 |
| 3190 | PRINT "Zu loeschender Datensatz:":GOSUB 6300 |
| 3200 | GOSUB 170 :GOSUB 530 :GOSUB 690 |
| 3210 | RESTORE 3230 :GOTO 7290 |
| 3230 | DATA 1,">>> ACHTUNG <<<",1,"PFLEGEMENU",2410,"Datensatz loeschen |
| 3240 | DATA 3250 |
| 3250 | CLEAR F2:IF P=G GOTO 3270 |
| 3260 | FOR I=0 TO 6:D$(P,I)=D$(G,I):NEXT I |
| 3270 | FOR L=0 TO 2:U=-1:V=-1:FOR I=0 TO G |
| 3280 | IF S(I,L)=P LET U=I |
| 3290 | IF S(I,L)=G LET V=I |
| 3300 | IF U>-1 AND V>-1 LET I=G |
| 3310 | NEXT I |
| 3320 | S(V,L)=P |
| 3330 | IF U=G GOTO 3370 |
| 3340 | FOR I=U+1 TO G |
| 3350 | S(I-1,L)=S(I,L) |
| 3360 | NEXT I |
| 3370 | NEXT L |
| 3380 | FOR I=0 TO 6:D$(G,I)="":NEXT I:FOR I=0 TO 2:S(G,I)=0:NEXT I |
| 3390 | G=G-1:PRINT "Datensatz geloescht !":GOSUB 6300 |
| 3400 | GOTO 70 |
| 3410 | IF F7 OR G7 OR H7 OR F6>=G GOTO 3690 |
| 3420 | IF F6 GOTO 3470 |
| 3430 | RESTORE 3450 :GOTO 7290 |
| 3450 | DATA 1,"Keine neuen Daten !" |
| 3460 | DATA 2,"Sortieren",3465,"DATENPFLEGE",2410,"MENU",70 |
| 3465 | F7=1:G7=1:H7=1:GOTO 3695 |
| 3470 | USING "####":PRINT 0;" % einsortiert":D=3*F6:Z=0 |
| 3480 | FOR I=F6 TO 1 STEP -1 |
| 3490 | FOR L=0 TO 2 |
| 3500 | M$(0)=D$(G-I+1,L):IF L=2 LET M$(0)=LEFT$ (D$(G-I+1,5),5):GOSUB 370 :GOTO 3520 |
| 3510 | GOSUB 260 |
| 3520 | ON L GOTO 3530 ,3550 |
| 3530 | IF D$(P,L)=M$(0) GOTO 3630 |
| 3540 | GOTO 3560 |
| 3550 | IF LEFT$ (D$(P,5),5)=M$(0) GOTO 3650 |
| 3560 | FOR J=G-I TO R STEP -1:S(J+1,L)=S(J,L):NEXT J |
| 3570 | S(R,L)=G-I+1 |
| 3580 | Z=Z+1:CURSOR 0,0:PRINT Z/D*100 |
| 3590 | NEXT L:NEXT I |
| 3600 | CLEAR F6:USING |
| 3610 | IF F8 GOTO 4180 |
| 3620 | GOTO 40 |
| 3630 | IF D$(P,NOT L+2)<D$(G-I+1,NOT L+2) LET R=R+1:P=S(R,L):IF R<G GOTO 3530 |
| 3640 | GOTO 3560 |
| 3650 | IF D$(P,0)<D$(G-I+1,0) LET R=R+1:P=S(R,L):IF R<G GOTO 3550 |
| 3660 | GOTO 3560 |
| 3670 | E=0:G=-1:F9=1:GOSUB 4480 :CLEAR F6,F9 |
| 3680 | CLS :PRINT "Bitte Daten eingeben !":GOSUB 6300 :GOTO 2460 |
| 3690 | IF F6 LET F7=1:G7=1:H7=1 |
| 3695 | D=(F7+G7+H7)*(G+1)^2:Z=0:USING "####.#":PRINT 0;" % sortiert |
| 3700 | L=0:IF F7=0 GOTO 3742 |
| 3710 | FOR I=0 TO G:K=0:FOR J=0 TO G |
| 3720 | IF D$(J,L)<=D$(I,L) LET K=K+1:IF D$(I,L)=D$(J,L) GOSUB 3830 |
| 3730 | Z=Z+1:CURSOR 0,0:PRINT Z/D*100 |
| 3740 | NEXT J:S(K,L)=I:NEXT I |
| 3742 | IF G7 LET L=1:G7=0:GOTO 3710 |
| 3746 | L=2:IF H7=0 GOTO 3810 |
| 3750 | FOR I=0 TO G:K=0:FOR J=0 TO G |
| 3760 | U=VAL MID$ (D$(I,5),4,2)*31+VAL LEFT$ (D$(I,5),2) |
| 3770 | V=VAL MID$ (D$(J,5),4,2)*31+VAL LEFT$ (D$(J,5),2) |
| 3780 | IF V<=U LET K=K+1:IF U=V GOSUB 3830 |
| 3790 | Z=Z+1:CURSOR 0,0:PRINT Z/D*100 |
| 3800 | NEXT J:S(K,2)=I:NEXT I |
| 3810 | USING :CLEAR F7,G7,H7,F6:IF F8 GOTO 4180 |
| 3820 | GOTO 40 |
| 3830 | O=-1:K=K-1:IF I=JRETURN |
| 3840 | O=O+1:IF O=4 GOSUB 3880 :RETURN |
| 3850 | IF D$(I,O)=D$(J,O) GOTO 3840 |
| 3860 | IF D$(J,O)<D$(I,O) LET K=K+1 |
| 3870 | RETURN |
| 3880 | IF I<J LET K=K+1 |
| 3890 | IF L OR I>J RETURN |
| 3900 | BEEP 1,255,200 |
| 3910 | CLS :PRINT "Doppelter Datensatz:":GOSUB 6300 |
| 3920 | P=I:GOSUB 690 |
| 3930 | PRINT " % sortiert":CURSOR 0,0:PRINT Z/D*100 |
| 3940 | RETURN |
| 3950 | IF F1=0 GOTO 4390 |
| 3960 | IF F2=0 GOTO 4170 |
| 3970 | RESTORE 3990 :GOTO 7290 |
| 3990 | DATA 1,"TRANSFER",2,"Sichern",4170,"Laden",4390,"MENU",70 |
| 4010 | DATA 1,"Datei unsortiert !",2,"Sortieren",3410,"sofort sichern",4180 |
| 4020 | DATA "MENU",4250 |
| 4060 | DATA 1,"LADEN",2,"Diskette",4400,"Eingabe",3670 |
| 4070 | DATA "MENU",70 |
| 4090 | DATA 1,"alte Datei",2,"erhalten",4720,"loeschen",4480,"MENU |
| 4100 | DATA 4710 |
| 4120 | DATA 1,"Speicher zu klein:",2,"Teil laden",4580,"neuer Filename" |
| 4130 | DATA 4880,"MENU",4700 |
| 4150 | DATA 1,"alte Datei:",2,"sichern und loeschen",4170 |
| 4160 | DATA "sofort loeschen",4470,"MENU",70 |
| 4170 | IF F6 OR F7 OR G7 OR H7 RESTORE 4010 :F8=1:GOTO 7290 |
| 4180 | CLEAR F8:D=10*G+10:Z=0 |
| 4190 | GOSUB 4340 :USING "####.#" |
| 4200 | OPEN "X:"+F$+".ADB"FOR OUTPUT AS #2 |
| 4210 | PRINT #2,G,F6,F7,FP:PRINT 0;" % gesichert |
| 4220 | FOR I=0 TO G:FOR J=0 TO 6:PRINT #2,D$(I,J):Z=Z+1:CURSOR 0,0:PRINT Z/D*100:NEXT J |
| 4230 | FOR J=0 TO 2:PRINT #2,S(I,J):Z=Z+1:CURSOR 0,0:PRINT Z/D*100:NEXT J:NEXT I |
| 4240 | F2=1 |
| 4250 | CLOSE :USING :IF FP=2 GOTO 120 |
| 4270 | GOTO 70 |
| 4340 | RESTORE 4365 :GOTO 7290 |
| 4350 | INPUT "Filename: ";F$ |
| 4360 | CLS :RETURN |
| 4365 | DATA 1,"CE-140F",1,"o.k.",4350,"MENU",70 |
| 4390 | Z=0:RESTORE 4060 :GOTO 7290 |
| 4400 | GOSUB 4340 |
| 4410 | OPEN "X:"+F$+".ADB"FOR INPUT AS #3 |
| 4420 | INPUT #3,U,V,W,A:D=10*U+10 |
| 4440 | E=U*192+341 |
| 4450 | IF A=FP AND M-G>U RESTORE 4090 :GOTO 7290 |
| 4480 | ERASE D$,S |
| 4490 | M=INT ((MEM -727)/192):IF M>255 LET M=255 |
| 4500 | PRINT "frei:":PRINT STR$ (MEM -727);" Bytes" |
| 4510 | IF MEM $="D" PRINT "Bitte eingeben:":PRINT "SETMEM ";CHR$ 34;"B";CHR$ 34;" ";CHR$ 91; |
| 4515 | IF MEM $="D" PRINT "ENTER";CHR$ 93:WAIT :PRINT "",CHR$ 91+"DEF"+CHR$ 93+" "+CHR$ 91+"C"+CHR$ 93 |
| 4516 | "C" WAIT 0 |
| 4520 | IF F9 GOSUB 6300 :GOSUB 4840 :GOTO 4580 |
| 4530 | PRINT "Neue Datei:":PRINT STR$ E;" Bytes":GOSUB 6300 |
| 4560 | IF U>M RESTORE 4120 :GOTO 7290 |
| 4570 | IF M-U>5 GOSUB 4820 |
| 4580 | CURSOR 5,1:PRINT "bitte Geduld |
| 4590 | DIM D$(M,6)*24,S(M,2):F1=1:F2=1:CLS |
| 4600 | IF F9 RETURN |
| 4605 | Z=0:USING "####.#":PRINT 0;" % geladen" |
| 4610 | FOR I=0 TO U:FOR J=0 TO 6 |
| 4620 | INPUT #3,D$(I,J):Z=Z+1:CURSOR 0,0:PRINT Z/D*100 |
| 4640 | NEXT J:FOR J=0 TO 2 |
| 4650 | INPUT #3,S(I,J):Z=Z+1:CURSOR 0,0:PRINT Z/D*100 |
| 4670 | NEXT J:NEXT I |
| 4680 | F6=V:F7=W:G=U:FP=A |
| 4690 | IF M<U LET F7=1 |
| 4700 | CLOSE :USING |
| 4710 | GOTO 70 |
| 4720 | Z=0:USING "####.#":PRINT 0;" % angehaengt" |
| 4725 | FOR I=G+1 TO G+U+1 |
| 4730 | FOR J=0 TO 6 |
| 4740 | INPUT #3,D$(I,J):Z=Z+1:CURSOR 0,0:PRINT Z/D*100 |
| 4760 | NEXT J:FOR J=0 TO 2 |
| 4770 | INPUT #3,S(I,J):Z=Z+1:CURSOR 0,0:PRINT Z/D*100 |
| 4790 | NEXT J:NEXT I |
| 4800 | G=G+U+1:CLOSE :F7=1:CLS :GOTO 3690 |
| 4820 | PRINT "Nicht benoetigt:":PRINT STR$ (MEM -727-E);" Bytes" |
| 4830 | PRINT "entspr. ";STR$ (M-U);" Datensaetze":GOSUB 6300 |
| 4840 | Z=0:PRINT "Reservieren:":PRINT " Bytes":CURSOR 0,1:INPUT Z |
| 4850 | CLS :IF Z>MEM -727-E BEEP 1,255,200:GOTO 4840 |
| 4860 | M=INT ((MEM -727-Z)/192):IF M>255 LET M=255 |
| 4870 | RETURN |
| 4880 | CLOSE :GOTO 4400 |
| 4890 | RESTORE 4910 :GOTO 7290 |
| 4910 | DATA 1,"OPTIONEN",4,"Notizen",4930,"Status",5390,"Crypto |
| 4920 | DATA 5620,"Kalender",6610,"MENU",70 |
| 4930 | RESTORE 4950 :GOTO 7290 |
| 4950 | DATA 1,"NOTIZEN",5,"Ausgabe",4970,"Notieren",5070,"Loeschen",5110 |
| 4960 | DATA "Sichern",5250,"Laden",5300,"MENU",70 |
| 4970 | IF C4=0 GOTO 5380 |
| 4980 | IF C4=1 LET K=0:GOTO 5030 |
| 4990 | RESTORE 5010 :GOTO 7290 |
| 5010 | DATA 1,"AUSGABE",C4-1,N$(0),5030,N$(1),5030,N$(2),5030 |
| 5020 | DATA N$(3),5030,N$(4),5030,N$(5),5030 |
| 5030 | Z=K:GOSUB 6310 :IF C1<>3 PRINT =LPRINT :IF C1=1 CONSOLE 24 |
| 5040 | PRINT N$(Z):IF C1=3 GOSUB 6300 |
| 5050 | PRINT =PRINT :CONSOLE 39 |
| 5060 | GOTO 70 |
| 5070 | IF C4=6 BEEP 1,255,100:PRINT "Notizspeicher voll !":GOSUB 6300 :GOTO 4930 |
| 5080 | PRINT "Notiz Nr. ";STR$ (C4+1);" von max. 6":INPUT N$(C4):C4=C4+1 |
| 5090 | POKE 12348,16:CLS |
| 5100 | GOTO 70 |
| 5110 | IF C4=0 GOTO 5380 |
| 5120 | IF C4=1 LET K=0:GOTO 5170 |
| 5130 | RESTORE 5150 :GOTO 7290 |
| 5150 | DATA 1,"LOESCHEN",C4-1,N$(0),5170,N$(1),5170,N$(2),5170 |
| 5160 | DATA N$(3),5170,N$(4),5170,N$(5),5170 |
| 5170 | Z=K:PRINT N$(Z):GOSUB 6300 |
| 5180 | RESTORE 5200 :GOTO 7290 |
| 5200 | DATA 1,">>> ACHTUNG <<<",2,"NOTIZEN",4930,"MENU",70 |
| 5210 | DATA "Notiz loeschen",5220 |
| 5220 | C4=C4-1:IF Z=C4 LET N$(Z)="":GOTO 4930 |
| 5230 | N$(Z)=N$(C4):N$(C4)="" |
| 5240 | GOTO 4930 |
| 5250 | IF C4=0 GOTO 5380 |
| 5260 | GOSUB 4340 |
| 5270 | OPEN "X:"+F$+".NTZ" FOR OUTPUT AS #4 |
| 5280 | PRINT #4,C4,N$(*):CLOSE |
| 5290 | GOTO 70 |
| 5300 | IF C4 RESTORE 5320 :GOTO 7290 |
| 5320 | DATA 1,">>> ACHTUNG <<<",2,"NOTIZEN",4930,"MENU",70 |
| 5330 | DATA "alle Notizen loeschen",5340 |
| 5340 | GOSUB 4340 |
| 5350 | OPEN "X:"+F$+".NTZ" FOR INPUT AS #5 |
| 5360 | INPUT #5,C4,N$(*):CLOSE |
| 5370 | GOTO 4930 |
| 5380 | PRINT "Keine Notiz !":GOSUB 6300 :GOTO 70 |
| 5390 | GOSUB 6310 |
| 5400 | IF C1<3 PRINT =LPRINT |
| 5410 | PRINT "MiJan":PRINT "Adressdatenbanksystem":PRINT "Copyright 1991" |
| 5420 | PRINT "by M. Janssen":IF C1=3 GOSUB 6300 |
| 5430 | PRINT "statischer RAM-Bedarf:":PRINT "20712 Bytes":PRINT "dynamischer RAM-Bedarf: |
| 5440 | WAIT :PRINT "192 Bytes je Datensatz":WAIT 0:CLS |
| 5450 | PRINT "freier Speicher:":PRINT STR$ MEM ;" Bytes" |
| 5460 | IF C1=3 GOSUB 6300 |
| 5470 | IF F1=0 GOTO 5550 |
| 5480 | PRINT STR$ (G+1);" von ";STR$ (M+1);" moeglichen":PRINT "Datensaetzen belegt" |
| 5490 | IF C1=3 GOSUB 6300 |
| 5500 | IF F2=0 PRINT "Datei nicht gesichert !" |
| 5510 | IF F7 PRINT "Datei ist unsortiert !":GOTO 5530 |
| 5520 | IF F6 PRINT STR$ F6;" neue Datensaetze":PRINT "noch einzusortieren" |
| 5530 | IF F2=0 OR F6 OR F7 AND C1=3 GOSUB 6300 |
| 5540 | GOTO 5570 |
| 5550 | PRINT "Keine Datei !":IF C1=3 GOSUB 6300 |
| 5560 | PRINT STR$ (C4-1);" von max. 6 Notizen":PRINT "belegt":IF C1=3 GOSUB 6300 |
| 5570 | IF FP PRINT "Aktuelle Datei |
| 5580 | ON FP GOTO 5600 ,5610 |
| 5590 | PRINT =PRINT :GOTO 70 |
| 5600 | PRINT "mit Password geschuetzt!":GOTO 5590 |
| 5610 | PRINT "codiert !":GOTO 5590 |
| 5620 | IF FP GOTO 6000 |
| 5630 | IF F1=0 PRINT "Keine Datei !":GOSUB 6300 :GOTO 40 |
| 5640 | RESTORE 5660 :GOTO 7290 |
| 5660 | DATA 1,"DATENSCHUTZ",2,"Password",5680,"Codieren",5710 |
| 5670 | DATA "MENU",70 |
| 5680 | PRINT "Password:":GOSUB 6110 |
| 5690 | P$(0)=M$(0) |
| 5700 | FP=1:GOTO 70 |
| 5710 | PRINT "ACHTUNG: Fehlerhafter Decodierungsversuch be- wirkt Datenverlust !" |
| 5720 | GOSUB 6300 :RESTORE 5800 :GOTO 7290 |
| 5730 | PRINT "Datei "; |
| 5740 | IF FP PRINT "decodieren:":GOTO 5760 |
| 5750 | PRINT "codieren" |
| 5760 | PRINT "1. Password:":GOSUB 6110 |
| 5770 | P$(0)=M$(0):PRINT "2. Password:":GOSUB 6110 :IF M$(0)=P$(0) BEEP 1,255,100:GOTO 5770 |
| 5780 | FOR I=1 TO 2:P$(0)=P$(0)+P$(0):M$(0)=M$(0)+M$(0):NEXT I |
| 5800 | DATA 0,1,"Abbruch",120,"o.k.",5730 |
| 5810 | Z=0:D=7*(G+1):USING "####.#":PRINT 0;" % "; |
| 5812 | IF FP PRINT "decodiert":GOTO 5820 |
| 5815 | PRINT "codiert |
| 5820 | T$(0)="":FOR I=1TO 24 |
| 5830 | A=ASC MID$ (P$(0),I,1):B=ASC MID$ (M$(0),I,1) |
| 5840 | T$(0)=T$(0)+CHR$ (AOR BAND NOT (AAND B)) |
| 5850 | NEXT I:M$(0)="":P$(0)=T$(0) |
| 5860 | FOR I=0 TO G:FOR J=0 TO 6 |
| 5870 | IF D$(I,J)=""GOTO 5930 |
| 5880 | T$(0)="" |
| 5890 | FOR K=1 TO LEN D$(I,J) |
| 5900 | A=ASC MID$ (P$(0),K,1):B=ASC MID$ (D$(I,J),K,1) |
| 5910 | T$(0)=T$(0)+CHR$ (A OR B AND NOT (A AND B)) |
| 5920 | NEXT K:D$(I,J)=T$(0) |
| 5930 | Z=I*7+J:CURSOR 0,0:PRINT Z/D*100 |
| 5940 | NEXT J:NEXT I |
| 5950 | M$(0)="":P$(0)="":T$(0)="":FP=ABS (FP-2):USING |
| 5960 | IF FP RESTORE 5990 :GOTO 7290 |
| 5970 | GOTO 40 |
| 5990 | DATA 0,1,"Codiert sichern",4170,"ENDE",120 |
| 6000 | ON FP GOTO 6010 ,5710 |
| 6010 | PRINT "Password:":FOR I=1 TO 3:GOSUB 6110 :CLS |
| 6020 | IF M$(0)=P$(0) LET I=3:FP=0:GOTO 6040 |
| 6030 | BEEP 1,255,100:PRINT I;" falsches Password !" |
| 6040 | NEXT I |
| 6050 | ON FP+1 GOTO 6060 ,160 |
| 6060 | RESTORE 6080 :GOTO 7290 |
| 6080 | DATA 1,"Passwordschutz",1,"erhalten",6090,"beenden",6100 |
| 6090 | FP=1:GOTO 50 |
| 6100 | P$(0)="":GOTO 50 |
| 6110 | M$(0)="":PRINT "?" |
| 6120 | T=ASC INKEY$ :IF T=0GOTO 6120 |
| 6130 | BEEP 1,1,25 |
| 6140 | IF T=13 GOTO 6200 |
| 6150 | IF T=15 AND LEN M$(0)>0 LET M$(0)=LEFT$ (M$(0),LEN M$(0)-1):GOTO 6120 |
| 6160 | IF T=2 CLS :PRINT "neue Eingabe !":GOTO 6110 |
| 6170 | IF T<32 OR T>122 AND T<>251 AND T<>252 BEEP 1,255,100:GOTO 6120 |
| 6180 | M$(0)=M$(0)+CHR$ T |
| 6190 | IF LEN M$(0)<16 GOTO 6120 |
| 6200 | CLS :IF LEN M$(0)<6 BEEP 1,255,100:PRINT "Password zu kurz !":GOTO 6110 |
| 6210 | IF FP=1 RETURN |
| 6220 | PRINT "Kontrolleingabe:":PRINT "?":FOR I=1 TO LEN M$(0) |
| 6230 | T=ASC INKEY$ :IF T=0 GOTO 6230 |
| 6240 | BEEP 1,1,25 |
| 6250 | IF T=15 LET I=I-1:GOTO 6230 |
| 6260 | IF T=2 LET I=1:PRINT "neue Eingabe !":GOTO 6230 |
| 6270 | IF T<>ASC MID$ (M$(0),I,1) BEEP 1,255,100:PRINT "Fehler !":I=16:NEXT I:GOSUB 6300 :CLS :GOTO 6110 |
| 6280 | NEXT I:CLS :RETURN |
| 6290 | PRINT "Eintraege nur":PRINT "von ";D$(S(0,L),L):PRINT "bis ";D$(S(G,L),L):PRINT "vorhanden |
| 6300 | WAIT :CURSOR 17,3:PRINT CHR$ 91;"ENTER";CHR$ 93:WAIT 0:BEEP 1,1,25:CLS :RETURN |
| 6310 | CLOSE #1:RESTORE 6400 :GOTO 7290 |
| 6320 | C1=1:PRINT "CE-140P"; |
| 6330 | GOTO 6350 |
| 6340 | C1=2:PRINT "CE-126P"; |
| 6350 | PRINT " o.k. ?":GOSUB 6300 |
| 6360 | IF C1=1 OPEN :LPRINT CHR$ 27+"@ |
| 6370 | RETURN |
| 6380 | C1=3:RETURN |
| 6400 | DATA 1,"ZIEL",2,"CE-140P (inkjet)",6320,"CE-126P (thermo)",6340 |
| 6410 | DATA "Display",6380 |
| 6420 | PRINT "Text eingeben:":PRINT CHR$ 91;"ENTER";CHR$ 93;" = "; |
| 6430 | IF LEN T$(0)>14 PRINT LEFT$ (T$(0),10);" ...":GOTO 6460 |
| 6440 | IF ASC T$(0)<33 PRINT "<SPC>":GOTO 6460 |
| 6450 | PRINT T$(0) |
| 6460 | INPUT T$(0) |
| 6470 | POKE 12348,16:CLS |
| 6480 | RETURN |
| 6490 | CLEAR F5:H=ASC LEFT$ (M$(0),1):IF H<65 OR H>90 AND H<>32 AND H<>0 LET F5=1 |
| 6500 | H=ASC MID$ (M$(0),2,1):IF H<97 OR H>122 AND H<>46 AND H<>32 AND H<>0 LET F5=1 |
| 6510 | CLS :IF F5 BEEP 1,255,200:RESTORE 6550 :GOTO 7290 |
| 6520 | POKE 12348,16 |
| 6530 | RETURN |
| 6550 | DATA 1,"EINGABEFEHLER",1,"o.k.",6520,"Hilfe",6560 |
| 6560 | PRINT "Text mit Kleinbuchstaben":PRINT "Abkuerzungen mit ";CHR$ 34;".";CHR$ 34 |
| 6570 | PRINT "hinter dem 1. Buchstaben":GOSUB 6300 :PRINT "Daten: TT.MM.JJJJ" |
| 6580 | PRINT "Freibleibende Felder mit";CHR$ 91;"ENTER";CHR$ 93;" quittieren |
| 6590 | GOSUB 6300 :GOTO 6520 |
| 6600 | DATA 31,28+S,31,30,31,30,31,31,30,31,30,31 |
| 6610 | D=1:INPUT "Monat: ";D |
| 6620 | IF D<1 OR D>12 BEEP 1,255,100:GOTO 6610 |
| 6630 | E=1991:INPUT "Jahr : ";E |
| 6640 | IF E<1000 BEEP 1,255,100:GOTO 6630 |
| 6650 | CLS :T$(0)="JANFEBMARAPRMAIJUNJULAUGSEPOKTNOVDEZ |
| 6660 | FOR I=1 TO 3:CURSOR 1,I-1:PRINT MID$ (T$(0),3*D+I-3,1):NEXT I |
| 6670 | CURSOR 0,3:PRINT RIGHT$ (STR$ E,2):CURSOR 3,0:PRINT "Mo Di Mi Do Fr Sa So |
| 6680 | LINE (20,0)-(149,6),X,BF:LINE (3,0)-(19,31),X,BF |
| 6690 | A=INT (E/100):B=E-A*100:Z=35+INT (1.25*(B-1))+INT (A/4)-2*A |
| 6700 | S=0:IF B/4=INT (B/4)LET S=1:IF B=0 AND A/4=INT (A/4) CLEAR S |
| 6710 | RESTORE 6600 :IF D=1 GOTO 6730 |
| 6720 | FOR I=1 TO D-1:READ N:Z=Z+N:NEXT I |
| 6730 | READ N:O=Z-INT (Z/7)*7 |
| 6740 | FOR I=1 TO 21-O |
| 6750 | Y=INT ((I+O-1)/7)+1:X=(I+O-(Y-1)*7)*3+(I<10) |
| 6760 | CURSOR X,Y:PRINT STR$ I |
| 6770 | NEXT I |
| 6780 | IF F1=0 GOTO 6880 |
| 6790 | M$(0)="01.":IF D<10 LET M$(0)=M$(0)+"0" |
| 6800 | M$(0)=M$(0)+STR$ D:GOSUB 370 |
| 6810 | IF VAL MID$ (D$(S(R,2),5),4,2)<>D GOTO 6880 |
| 6820 | C=VAL LEFT$ (D$(S(R,2),5),2) |
| 6830 | IF C>21-O GOTO 6880 |
| 6840 | Y=INT ((C+O-1)/7)+1:X=(C+O-(Y-1)*7)*3+2 |
| 6850 | CURSOR X,Y:PRINT "*" |
| 6860 | R=R+1:IF R>G GOTO 6880 |
| 6870 | GOTO 6810 |
| 6880 | IF C4=0 GOTO 6970 |
| 6890 | FOR I=0 TO C4-1 |
| 6900 | IF VAL N$(I)=0 GOTO 6960 |
| 6910 | U=VAL LEFT$ (N$(I),2):V=VAL MID$ (N$(I),4,2):W=1991 |
| 6920 | IF V<>D OR U>21-O GOTO 6960 |
| 6930 | Y=INT ((U+O-1)/7)+1:X=(U+O-(Y-1)*7)*3+2 |
| 6940 | CURSOR X,Y:IF POINT (X*6+8,Y*8+3) PRINT "+":GOTO 6960 |
| 6950 | PRINT "!" |
| 6960 | NEXT I |
| 6970 | GOSUB 7250 |
| 6980 | BEEP 1:WAIT :GPRINT :WAIT 0:LINE (23,6)-(23,31),R |
| 6990 | FOR I=1 TO N-21+O |
| 7000 | Y=INT ((I-1)/7)+1:X=(I-(Y-1)*7)*3 |
| 7010 | CURSOR X,Y:PRINT STR$ (I+21-O);" ":NEXT I |
| 7020 | FOR I=N-20+O TO 21 |
| 7030 | Y=INT ((I-1)/7)+1:X=(I-(Y-1)*7)*3 |
| 7040 | CURSOR X,Y:PRINT " ":NEXT I |
| 7050 | IF F1=0 GOTO 7130 |
| 7060 | M$(0)=STR$ (22-O)+".":IF D<10 LET M$(0)=M$(0)+"0" |
| 7070 | M$(0)=M$(0)+STR$ D:GOSUB 370 |
| 7080 | IF VAL MID$ (D$(S(R,2),5),4,2)<>D GOTO 7130 |
| 7090 | C=VAL LEFT$ (D$(S(R,2),5),2)-21+O:Y=INT ((C-1)/7)+1:X=(C-(Y-1)*7)*3+2 |
| 7100 | CURSOR X,Y:PRINT "*" |
| 7110 | R=R+1:IF R>G GOTO 7130 |
| 7120 | GOTO 7080 |
| 7130 | IF C4=0 GOTO 7230 |
| 7140 | FOR I=0 TO C4-1 |
| 7150 | IF VAL N$(I)=0 GOTO 7220 |
| 7160 | U=VAL LEFT$ (N$(I),2):V=VAL MID$ (N$(I),4,2):W=1991 |
| 7170 | IF V<>D OR U<22-O GOTO 7220 |
| 7180 | U=U-21+O |
| 7190 | Y=INT ((U-1)/7)+1:X=(U-(Y-1)*7)*3+2 |
| 7200 | CURSOR X,Y:IF POINT (X*6+8,Y*8+3)PRINT "+":GOTO 7220 |
| 7210 | PRINT "!" |
| 7220 | NEXT I |
| 7230 | GOSUB 7250 :BEEP 1:WAIT :GPRINT :WAIT 0 |
| 7240 | GOTO 70 |
| 7250 | FOR Y=11 TO 27 STEP 8:FOR X=38 TO 146 STEP 18 |
| 7260 | IF POINT (X,Y) LINE (X+2,Y+4)-(X-15,Y-3),X,BF |
| 7270 | NEXT X:NEXT Y |
| 7280 | RETURN |
| 7290 | CLS :READ F0:IF F0 READ M$(0):PRINT M$(0) |
| 7300 | X=0:Y=F0:READ N:Q=INT (N/(4-F0)):S=16-4*Q |
| 7310 | FOR I=0 TO N:J=INT (I/(4-F0)):CURSOR J*S,I-(4-F0)*J+F0:READ M$(0),Z(I) |
| 7320 | PRINT " ";LEFT$ (M$(0),S+6-8*SGN Q):NEXT I |
| 7330 | K=Y-F0+(4-F0)*X:IF K>N LET X=Q:Y=F0+N-(4-F0)*X:K=N |
| 7340 | CURSOR X*S,Y:PRINT "->" |
| 7350 | FOR I=0 TO 9999:T=ASC INKEY$ :IF T=0 NEXT I |
| 7355 | IF T=0 CLS :GOTO 120 |
| 7360 | BEEP 1,1,25:I=9999:NEXT I |
| 7370 | IF T=5 CURSOR X*S,Y:PRINT " ":Y=Y+1:IF Y>3 LET Y=F0:X=X+1:IF X>Q CLEAR X |
| 7380 | IF T=4 CURSOR X*S,Y:PRINT " ":Y=Y-1:IF Y<F0 LET Y=3:X=X-1:IF -X CLEAR X |
| 7390 | IF T=14 CURSOR X*S,Y:PRINT " ":X=X+1:IF X>Q CLEAR X |
| 7400 | IF T=15 CURSOR X*S,Y:PRINT " ":X=X-1:IF X<0 LET X=Q |
| 7410 | IF T=13 CLS :CLEAR X,Y:GOTO Z(K) |
| 7420 | GOTO 7330 |
| 7430 | DIM P$(0)*24,T$(0)*62,N$(5)*80,M$(0)*24,Z(8):C2=1 |
| 7440 | RETURN |
| 7450 | U=0:IF F2 GOTO 3670 |
| 7460 | RESTORE 7470 :GOTO 7290 |
| 7470 | DATA 1,">>> ACHTUNG <<<",2,"alte Datei sichern",4170,"alte Datei loeschen |
| 7480 | DATA 3670,"MENU",70 |
| Standardvariablen | |
| A | > Suchroutine: Intervallgrenze, sonst: Zwischenspeicher |
| B | |
| C | Index in S, bei dem eine Liste beginnt |
| D | 100%-Wert |
| E | Speicherplatz, der für zu ladende datei benötigt wird |
| F$ | Dateiname |
| G | Anzahl gespeicherter Datensätze |
| H$ | Testbuchstabe, Hilfsvariable |
| I | > Schleifenvariablen |
| J | |
| K | Nummer der Menüauswahl |
| L | Listennr. (zweiter Index in S) |
| M | Anzahl möglicher Datensätze |
| N | Anzahl Auswahltexte eines Menüs |
| O | Ausweichkriterium beim Sortieren (Index in D$) |
| P | Index in D$ des ausgewählten Datensatzes |
| Q | Spaltenzahl im Menü |
| R | Indes in S des ausgewählten Datensatzes |
| S | Cursorposition im Menü |
| T | ASCII-Code der Tastaturabfrage |
| U | > Geburtsdatum Tag, Monat, Jahr; Hilfsvariablen |
| V | |
| W | |
| X | > Menücursor |
| Y | |
| Z | frei gehaltener Speicherplatz, %-Zähler |
| Freie Variablen |
|
| F0 | Menükopfzeile ja/nein 1/0 |
| F1 | Datei im Rechner geladen ja/nein 1/0 |
| F2 | geladene Datei gesichert ja/nein 1/0 |
| F4 | Vornamen- plus Nachnamenlänge <= 24? Ja/nein 1/0 |
| F5 | Fehleingabe ja/nein 1/0 |
| F6 | Anzahl noch nicht einsortierter Datensätze |
| F7 | Nachname nach dem Sortieren verändert ja/nein 1/0 |
| G7 | Vorname nach dem Sortieren verändert ja/nein 1/0 |
| H7 | Geburtstag nach dem Sortieren verändert ja/nein 1/0 |
| F9 | Aufruf der Felddimensionierung aus "Laden/Eingabe" ja/nein 1/0 |
| C1 | Ausgabegerät 1=CE-140P, 2=CE-126P, 3=Display |
| C2 | statische Feldvariablen dimensioniert ja/nein 1/0 |
| FP | Datenschutz: 0=ohne, 1=Passwort, 2=Verschlüsselung |
| C4 | erste freie Notiz (Nr.) |
| G1 | Schriftart (normal, gesperrt, schattiert) |
| G2 | Schriftgröße |
| G3 | mehrfarbiger Druck ja/nein 1/0 |
| G4 | Unterstreichen (0=ohne, 1=punktiert, 2=einfach, 3=doppelt) |
| GX | > Größe des bedruckten Feldes |
| GY | |
| Feldvariablen |
|
| D$(M,6) | Adressdaten |
| S(M,2) | sortierte Pointerliste |
| N$(5)*80 | Notizen |
| M$(0)*24 | Menütextzeile |
| Z(8) | Zeilennummern, zu denen die Menüroutine verzweigt |
| T$(0)*62 | Texteingabezeile |
| P$(0)*24 | Passwort |
Dokumentation ansehen
Programmspeicher-Image laden
|
|
Falls diese Seite ohne Navigationsleiste angezeigt wird, aktivieren Sie Javascript oder klicken Sie hier!