Sharp PC1360 Taschencomputer
 

 Sharp PC1360

Adressdatenbank und Organizer

Teilprogramm 2 - Listing


Dokumentation ansehen
Listing Teil 1, ADBCHN.BAS
Listing Teil 3, STATCHN.BAS
Listing Teil 4, PFLEGCHN.BAS
Listing Teil 5, SORTCHN.BAS
Listing Teil 6, TRANSCHN.BAS
Listing Teil 7, CRYPTCHN.BAS
Programmspeicher-Image laden (1)
Programmspeicher-Image laden (2)
Programmspeicher-Image laden (3)
Programmspeicher-Image laden (4)
Programmspeicher-Image laden (5)
Programmspeicher-Image laden (6)
Programmspeicher-Image laden (7)


10 AUTOGOTO 70
70 "A" GOSUB 7490 :CHAIN "X:ADBCHN.PRG",70
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)<3 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>1999LET 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
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=0 BEEP 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
6300 WAIT :CURSOR 17,3:PRINT CHR$ 91;"ENTER";CHR$ 93:WAIT 0:BEEP 1,1,25:CLS :RETURN
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
7290 CLS :WAIT 0: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 T=ASC INKEY$ :IF T=0 GOTO 7350
7360 BEEP 1,1,25
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
7490 RESTORE 7500 :GOTO 7290
7500 DATA 1,"Externer Programmteil !",1,"CE-140F o.k.",7510,"Abbruch",7520
7510 RETURN
7520 CLS :END


Dokumentation ansehen
Listing Teil 1, ADBCHN.BAS
Listing Teil 3, STATCHN.BAS
Listing Teil 4, PFLEGCHN.BAS
Listing Teil 5, SORTCHN.BAS
Listing Teil 6, TRANSCHN.BAS
Listing Teil 7, CRYPTCHN.BAS
Programmspeicher-Image laden (1)
Programmspeicher-Image laden (2)
Programmspeicher-Image laden (3)
Programmspeicher-Image laden (4)
Programmspeicher-Image laden (5)
Programmspeicher-Image laden (6)
Programmspeicher-Image laden (7)



Zur Übersichtstabelle



Home
Falls diese Seite ohne Navigationsleiste angezeigt wird, aktivieren Sie Javascript oder klicken Sie hier!