10 ! ====================================================== 20 ! program REGISTER.BAC ISAM-program 30 ! Version 3.6 - 1984-06-20 40 ! 50 ! (C) Leif Eriksson < 397 > 51 ! G{vle 026-195271 60 ! 70 ! 80 ! ====================================================== 90 ! 100 EXTEND 110 INTEGER 120 OPTION BASE 1 130 ! 140 ! 150 True=-1 : False=0 160 ! 170 DEF FNRad25$(Text$) LOCAL Vdu$=0 180 OUT 56,6,57,25 190 POKE VAROOT(Vdu$),80,0,32640,127 200 Vdu$=(Text$) 210 RETURN '' 220 FNEND 230 ! 240 ! 250 DEF FNInv$(Text$) LOCAL Text$=80 260 FOR I=1 TO LEN(Text$) 270 PUT (CHR$(ASCII(MID$(Text$,I,1)) OR 128)) 280 NEXT I 290 RETURN '' 300 FNEND 310 ! 320 ! 330 DEF FNRam$ ! Ram p} sk{rm 340 PRINT CUR(0,0) STRING$(80,61) 350 PRINT CUR(23,0) STRING$(80,61); 360 PRINT CUR(2,0) STRING$(80,61) 370 RETURN '' 380 FNEND 390 ! 400 ! 410 DEF FNMeny$ 420 PRINT FNRam$ 430 PRINT CUR(1,1) FNInv$('ISAM-databas * '+Fil$+' * '); 440 PRINT TAB(60) 'Antal poster ' Postant 450 PRINT CUR(11,3) 'Inmatning: PF2:' 460 PRINT CUR(13,3) 'S|kning/[ndring/Borttagning: PF3:' 470 PRINT CUR(15,3) 'Lista hela register: PF4:' 480 PRINT CUR(17,3) 'Lista p} printer: PF5:' 490 PRINT CUR(9,3) ']ter till Menyn: PF1:' 500 RETURN '' 510 FNEND 520 ! 530 ! 540 DEF FNSudda(Fr,Ti) LOCAL Fr,Ti 550 FOR I=Fr TO Ti 560 PRINT CUR(I,0) SPACE$(80); 570 NEXT I 580 RETURN True 590 FNEND 600 ! 610 ! 1000 DEF FNPftangent(Gr{ns,R,K) LOCAL V{lj,R,K 1010 ON ERROR GOTO 1060 1020 PRINT CUR(1,36) TIME$ 1030 IF SYS(5) THEN 1050 1040 GOTO 1020 1050 PRINT CUR(R,K); : INPUT ''I : GOTO 1050 1060 IF ERRCODE<>53 THEN RESUME 1010 1070 I=SYS(6) ! L{gg tillbaka tecken i buffert 1080 GET P$ 1090 I=ASCII(P$)-191 ! I har koden 1100 IF I<1 OR I>Gr{ns THEN RESUME 1010 1110 V{lj=I 1120 RESUME 1130 1130 RETURN V{lj 1140 FNEND 1150 ! 1160 ! 2000 DEF FNOpenisam 2010 PRINT CUR(5,0); 2020 ON ERROR GOTO 2700 2030 OPEN 'DR1:DATA.ISM' AS FILE 6 2040 POSIT #6,25 2050 GET #6,P$ COUNT 2 2060 Postl{ngd=CVT$%(P$) 2070 OPEN 'DR1:DATA.ID' AS FILE 2 2080 ISAM OPEN 'DR1:DATA.ISM' AS FILE 1 2090 GET #2,P$ COUNT 2 2100 Postant=CVT$%(P$) 2110 GET #2,P$ COUNT 2 2120 Antalf{lt=CVT$%(P$) 2130 GET #2,P$ COUNT 2 2140 Nyckelant=CVT$%(P$) 2150 GET #2,Fil$ COUNT 12 2160 DIM L{ngd(Antalf{lt),Namn$(Antalf{lt),F{lttyp(Antalf{lt),Length(Antalf{lt) 2170 FOR I=1 TO Antalf{lt 2180 GET #2,P$ COUNT 2 2190 L{ngd(I)=CVT$%(P$) 2200 IF Max196 ! PF5 4080 PRINT CUR(Rad+3,Kol+20); 4090 GET P$ : Kod=ASCII(P$) 4091 IF Kod<>192 THEN 4100 ! PF1 }ter till meny 4092 Z=FNSudda(20,22) 4093 PRINT FNRad25$(SPACE$(79)) 4094 RETURN False 4100 IF Kod<>13 THEN 4140 ! RETURN 4110 Kol=1 4120 Rad=Rad+1 ! flytta ner 4130 IF Rad>Antalf{lt THEN Rad=Rad-1 : ; CHR$(7) 4140 IF Kod<>193 THEN 4180 ! PF2 4150 Kol=1 4160 Rad=Rad-1 ! flytta upp 4170 IF Rad<1 THEN Rad=1 : ; CHR$(7) 4180 IF Kod<>194 THEN 4240 ! PF3 4190 IF Kol=1 THEN 4210 4200 Temp$=LEFT$(F{lt$(Rad),Kol-1)+RIGHT$(F{lt$(Rad),Kol+1)+'_' : GOTO 4220 4210 Temp$=RIGHT$(F{lt$(Rad),Kol+1)+'_' 4220 F{lt$(Rad)=Temp$ 4230 PRINT CUR(Rad+3,21) F{lt$(Rad) 4240 IF Kod<>195 THEN 4300 ! PF4 4250 IF Kol=1 THEN 4270 4260 Temp$=LEFT$(F{lt$(Rad),Kol-1)+'_'+RIGHT$(F{lt$(Rad),Kol) : GOTO 4280 4270 Temp$='_'+RIGHT$(F{lt$(Rad),Kol) 4280 F{lt$(Rad)=LEFT$(Temp$,LEN(Temp$)-1) 4290 PRINT CUR(Rad+3,21) F{lt$(Rad) 4300 IF Kod<>197 THEN 4360 ! PF6 4310 IF X=False THEN 4470 4320 FOR I=1 TO Antalf{lt 4330 F{lt$(I)=Tempf{lt$(I) 4340 NEXT I 4350 GOTO 4040 4360 IF Kod<>9 THEN 4390 ! h|gerpil 4370 Kol=Kol+1 4380 IF Kol>Length(Rad) THEN Kol=Kol-1 : ; CHR$(7) 4390 IF Kod<>8 THEN 4420 ! v{nsterpil 4400 Kol=Kol-1 4410 IF Kol<1 THEN Kol=1 : ; CHR$(7) 4420 IF Kod<32 OR Kod>127 THEN 4470 4430 IF Kol>Length(Rad) THEN ; CHR$(7) : GOTO 4470 4440 MID$(F{lt$(Rad),Kol,1)=CHR$(Kod) 4450 PRINT CUR(Rad+3,Kol+20) CHR$(Kod) 4460 Kol=Kol+1 4470 WEND 4480 Z=FNSudda(20,22) 4490 PRINT FNRad25$(SPACE$(79)) 4540 RETURN True 4550 ! 4560 RESUME 4010 4570 FNEND 4580 ! 4590 ! 5000 DEF FNInmatning LOCAL Forts,Radera,Fel 5010 PRINT CUR(1,36) SPACE$(19) 5020 Z=FNSudda(3,22) 5030 PRINT FNInmeny$ 5040 Z=FNInfo(12) 5050 GOTO 5110 5060 FOR I=1 TO Antalf{lt 5070 Tempf{lt$(I)=F{lt$(I) 5080 F{lt$(I)=STRING$(Length(I),95) 5090 NEXT I 5100 RETURN 5110 GOSUB 5060 5120 Forts=True 5130 WHILE Forts=True 5140 Forts=FNInkontroll(True) 5150 IF Forts=False THEN 5260 ! slut 5160 IF NOT FNPacka THEN Z=FNInfo(14) : Z=FNInfo(12) : GOTO 5140 5170 ON ERROR GOTO 5290 5180 ISAM WRITE #1 Post$ 5190 Postant=Postant+1 5200 OPEN 'DR1:DATA.ID' AS FILE 10 5210 PUT #10 CVT%$(Postant) 5220 CLOSE 10 5230 PRINT CUR(1,72) Postant 5240 Z=FNInfo(12) 5250 GOSUB 5060 5260 WEND 5270 ! 5280 RETURN True 5290 RESUME 5310 5300 ! 5310 IF ERRCODE=121 THEN Fel=4 ELSE Fel=3 5320 Z=FNInfo(Fel) 5330 RETURN False 5340 FNEND 5350 ! 5360 ! 6000 DEF FNInfo(Nr) 6010 PRINT FNRad25$(SPACE$(80)); 6020 Z=FNSudda(20,22) 6030 PRINT CUR(20,0); 6040 ON ERROR GOTO 6460 6050 ON Nr GOTO 6060,6120,6140,6160,6190,6230,6250,6270,6290,6310,6330,6360,6100,6400,6420,6432 6060 PRINT 'Det finns ingen ISAM-fil.' 6070 PRINT 'Du m}ste skapa den med' 6080 PRINT 'alternativ 2 i menyprogrammet.'; 6090 GOTO 6440 6100 PRINT 'Sl} p} skrivaren!' 6110 GOTO 6440 6120 PRINT 'Det finns inga poster inmatade !' 6130 GOTO 6440 6140 PRINT 'Fel vid skrivning av post.' 6150 GOTO 6440 6160 PRINT 'Dubblettnyckel !!!' 6170 PRINT 'Posten lagras EJ.' 6180 GOTO 6440 6190 PRINT ' PF1 = Avbryt PF2 = [ndra' 6200 PRINT ' PF3 = F|reg}ende post PF4 = N{sta post' 6210 PRINT ' PF5 = Printer PF6 = Radera post' 6220 RETURN True 6230 PRINT 'Det finns ingen f|reg}ende post.' 6240 GOTO 6440 6250 PRINT 'Det finns ingen n{sta post.' 6260 GOTO 6440 6270 PRINT 'Fel vid raderingen.' 6280 GOTO 6440 6290 PRINT 'Fel vid l{sningen.' 6300 GOTO 6440 6310 PRINT 'S|kbegreppet finns ej!' 6320 GOTO 6440 6330 PRINT 'PF1 = Avbryt' 6340 PRINT 'PF3 = F|reg}ende post PF4 = N{sta post' 6350 RETURN True 6360 PRINT ' PF1 }ter Meny. PF2 flytta upp ett f{lt.' 6370 PRINT ' PF3 ta bort ett tecken. PF4 skjut in ett tecken.' 6380 PRINT ' PF5 klar. --> mark|r h|ger. <-- mark|r v{nster.' 6390 RETURN True 6400 PRINT 'F{lt ej numeriskt!!!' 6410 GOTO 6440 6420 PRINT 'Dublettnyckel !!!' 6430 PRINT 'Posten g}r ej att }terf}.' : GOTO 6440 6432 PRINT 'Felaktig Printerkod.!!' 6440 PRINT FNRad25$('Tryck p} CE eller CTRL-X') 6450 ; CUR(22,78); : GET P$ 6460 IF P$<>CHR$(24) THEN 6450 6470 PRINT FNRad25$(SPACE$(40)) 6480 RETURN Nr 6490 FNEND 6500 ! 6510 ! 7000 DEF FNListning ! p} bildsk{rm 7010 IF Postant=0 THEN Z=FNInfo(2) : RETURN False 7020 PRINT CUR(4,5) 'Listan kan sorteras efter:' 7030 FOR I=1 TO Nyckelant 7040 PRINT CUR(I+4,5) Nyckel$(I) ' Alt: ' I 7050 NEXT I 7060 ON ERROR GOTO 7090 7070 PRINT TAB(6) 'Vilket alternativ '; : INPUT P$ 7080 P=VAL(P$) : GOTO 7110 7090 PRINT 'Svara med ett tal!' 7100 RESUME 7070 7110 IF NOT (P>0 AND P<=Nyckelant) THEN 7070 7120 Z=FNSudda(3,22) 7130 Z=FNInfo(11) 7140 PRINT FNInmeny$ 7150 Index$=Nyckel$(P) 7160 ON ERROR GOTO 7190 7170 ISAM READ #1,Post$ INDEX Index$ FIRST 7180 GOTO 7200 7190 Fel=9 : RESUME 7380 7200 Z=FNPackaupp 7210 FOR I=1 TO Antalf{lt 7220 PRINT CUR(I+3,21) F{lt$(I) 7230 NEXT I 7240 Z=FNPftangent(4,21,75) 7250 IF Z=1 THEN 7400 ! klar 7260 IF Z=2 THEN 7240 ! ej till}tet 7270 ON Z-2 GOTO 7330,7280 7280 ON ERROR GOTO 7310 7290 ISAM READ #1,Post$ INDEX Index$ NEXT 7300 GOTO 7200 ! skriv post 7310 IF ERRCODE=34 THEN Fel=7 ELSE Fel=9 7320 RESUME 7380 7330 ON ERROR GOTO 7360 7340 ISAM READ #1,Post$ INDEX Index$ PREVIOUS 7350 GOTO 7200 ! skriv 7360 IF ERRCODE=34 THEN Fel=6 ELSE Fel=9 7370 RESUME 7380 7380 ! 7390 Z=FNInfo(Fel) 7400 Z=FNSudda(3,22) 7410 RETURN True 7420 FNEND 7430 ! 7440 ! 8000 DEF FNHuvud(P) 8010 PRINT #10,CHR$(18) STRING$(80,61) 8020 PRINT #10,TAB(2) 'REGISTER ' Fil$ ' Sorterad efter: ' Index$ TAB(58) LEFT$(TIME$,10);TAB(72) 'Sida:' P 8030 PRINT #10,STRING$(80,61) 8040 PRINT #10 8050 RETURN True 8060 FNEND 8070 ! 8080 ! 8090 DEF FNSidavslut 8100 Sida=Sida+1 8110 PRINT #10 8120 PRINT #10,CHR$(18) STRING$(80,61) 8130 PRINT #10,CHR$(12) 8140 RETURN 4 8150 FNEND 8160 ! 8170 ! 9000 DEF FNPrut(X,R) LOCAL F{lt,Pos,Temp$=50 9010 ON X GOTO 9020,9060,9160,9330 9020 FOR I=1 TO Antalf{lt 9030 PRINT #10,TAB(Tab1) Namn$(I) TAB(Tab1+23) F{lt$(I) 9040 R=R+1 9050 NEXT I : GOTO 9270 9060 ! packad utskrift 9070 F{lt=1 9080 FOR I=1 TO Rad 9090 PRINT #10 TAB(Tab1); 9100 FOR J=1 TO Rad(I) 9110 PRINT #10,Namn$(F{lt) F{lt$(F{lt) ' / '; 9120 F{lt=F{lt+1 9130 NEXT J 9140 R=R+1 9150 NEXT I : GOTO 9250 9160 ! egen formatterad utskrift 9170 F{lt=1 9180 FOR I=1 TO Rad 9190 FOR J=1 TO Rad(I) 9200 PRINT #10 TAB(Tab2(I,J)) Namn$(F{lt) F{lt$(F{lt); 9210 F{lt=F{lt+1 9220 NEXT J 9230 R=R+1 9240 NEXT I 9250 ! 9260 PRINT #10 9270 PRINT #10 CHR$(10) 9280 R=R+2 9290 IF R+Antal>64 THEN ; #10 CHR$(12) ELSE 9530 9300 R=4 9310 Sida=Sida+1 9320 Z=FNHuvud(Sida) : RETURN R 9330 ! ---- en post / rad ---- 9340 PRINT #10,TAB(Tab1) F{lt$(1); 9350 FOR I=2 TO Antalf{lt 9360 PRINT #10,' '+F{lt$(I); 9370 NEXT I 9380 R=R+1 9390 IF R>63 THEN R=FNSidavslut ELSE 9530 9400 Z=FNHuvud(Sida) 9410 IF LEN(Namn$(1))>Length(1) THEN Temp$=LEFT$(Namn$(1),Length(1)+1) ELSE Temp$=Namn$(1) 9420 IF Postlength<=80-((Antalf{lt-1)*2)-Tab1 THEN 9440 9430 PRINT #10,CHR$(F|rm) TAB(Tab1) Temp$; : GOTO 9450 9440 PRINT #10,TAB(Tab1) Temp$; 9450 Pos=Tab1+Length(1)+2 9460 FOR I=2 TO Antalf{lt 9470 IF LEN(Namn$(I))>Length(I) THEN Temp$=LEFT$(Namn$(I),Length(I)+1) ELSE Temp$=Namn$(I) 9480 PRINT #10,TAB(Pos) Temp$; 9490 Pos=Pos+Length(I)+2 9500 NEXT I 9510 PRINT #10 : R=R+2 9520 ! 9530 RETURN R 9540 FNEND 9550 ! 9560 ! 10000 DEF FNPrinter LOCAL Rader,Slutflagga,Pos,Temp$=50 ! hela listan p} printer 10010 Z=FNSudda(3,22) 10020 IF Postant=0 THEN Z=FNInfo(2) : RETURN False 10030 PRINT CUR(5,5) 'F|r avslut, tryck valfri tangent.' 10040 PRINT CUR(6,5) 'P}g}ende post skrivs f{rdigt.' 10050 PRINT CUR(7,5) 'Listan kan sorteras efter:' 10060 FOR I=1 TO Nyckelant 10070 PRINT CUR(I+8,5) Nyckel$(I) ' Alt: ' I 10080 NEXT I 10090 ON ERROR GOTO 10120 10100 P$=FNInp$(CUR(20,7)+'Vilket alternativ ',2) 10110 P=VAL(P$) : GOTO 10140 10120 PRINT 'Svara med ett tal!' 10130 RESUME 10100 10140 IF NOT (P>0 AND P<=Nyckelant) THEN 10100 10150 ; : PRINT 'Ett |gonblick, jag skriver.' 10160 Index$=Nyckel$(P) 10170 ON ERROR GOTO 10490 10180 ISAM READ #1,Post$ INDEX Index$ FIRST 10190 Z=FNPackaupp 10200 Rader=4 : Sida=1 10210 PREPARE 'PR:'+Printer$ AS FILE 10 10220 Z=FNHuvud(Sida) 10230 IF Typ<>4 THEN 10360 10240 IF LEN(Namn$(1))>Length(1) THEN Temp$=LEFT$(Namn$(1),Length(1)+1) ELSE Temp$=Namn$(1) 10250 IF Postlength<=80-((Antalf{lt-1)*2)-Tab1 THEN 10270 10260 PRINT #10,CHR$(F|rm) TAB(Tab1) Temp$; : GOTO 10280 10270 PRINT #10,TAB(Tab1) Temp$; 10280 Pos=Tab1+Length(1)+2 10290 FOR I=2 TO Antalf{lt 10300 IF LEN(Namn$(I))>Length(I) THEN Temp$=LEFT$(Namn$(I),Length(I)+1) ELSE Temp$=Namn$(I) 10310 PRINT #10,TAB(Pos) Temp$; 10320 Pos=Pos+Length(I)+2 10330 NEXT I 10340 PRINT #10 : Rader=Rader+2 10350 ! 10360 Slutflagga=False 10370 IF Typ=1 THEN Antal=Antalf{lt ELSE Antal=Rad 10380 WHILE NOT Slutflagga 10390 Rader=FNPrut(Typ,Rader) 10400 ISAM READ #1,Post$ INDEX Index$ NEXT 10410 IF SYS(5) THEN Slutflagga=True ! tangent ? 10420 Z=FNPackaupp 10430 WEND 10440 PRINT #10 10450 PRINT #10,CHR$(Norm) STRING$(80,61) 10460 CLOSE 10 10470 Z=FNSudda(3,22) 10480 RETURN True 10490 RESUME 10500 10500 IF ERRCODE=42 THEN Z=FNInfo(13) : RETURN False 10505 IF ERRCODE=21 THEN Z=FNInfo(16) : RETURN False 10510 IF ERRCODE<>34 THEN Z=FNInfo(9) 10520 GOTO 10440 10530 FNEND 10540 ! 10550 ! 11000 DEF FNPacka LOCAL Pos,Sv.,P,Fel,A,Posi,Skr{p$=1 11010 Pos=1 : Fel=False 11020 ON ERROR GOTO 11500 11030 Post$=STRING$(Postl{ngd,95) 11040 FOR I=1 TO Antalf{lt 11050 Temp$=F{lt$(I) 11060 IF F{lttyp(I)>1 THEN GOSUB 11220 : GOTO 11160 11070 Posi=L{ngd(I) 11080 Skr{p$=RIGHT$(Temp$,Posi) 11090 WHILE Skr{p$='_' AND Posi>0 11100 MID$(Temp$,Posi,1)=CHR$(32) ! blank 11110 Posi=Posi-1 11120 IF Posi=0 THEN 11140 11130 Skr{p$=MID$(Temp$,Posi,1) 11140 WEND 11150 ! 11160 IF Fel=True THEN RETURN False 11170 MID$(Post$,Pos,L{ngd(I))=Temp$ 11180 Pos=Pos+L{ngd(I) 11190 NEXT I 11200 PRINT FNInmeny$ ! f|r att radera ev. pil 11210 RETURN True 11220 ON ERROR GOTO 11460 11230 FOR J=1 TO LEN(Temp$) 11240 A=ASCII(MID$(Temp$,J,1)) 11250 IF A=95 THEN MID$(Temp$,J,1)=CHR$(32) 11260 NEXT J 11270 Sv.=VAL(Temp$) 11280 ON F{lttyp(I)-1 GOTO 11290,11340,11340 11290 ! heltal 11300 Temp$=CVT%$(INT(Sv.)) 11310 F{lt$(I)=NUM$(INT(Sv.)) 11320 F{lt$(I)=F{lt$(I)+STRING$(Length(I)-LEN(F{lt$(I)),95) 11330 RETURN 11340 ! flyttal 11350 Temp$=CVTF$(Sv.) 11360 F{lt$(I)=NUM$(Sv.) 11370 IF INSTR(1,F{lt$(I),'.')=0 THEN F{lt$(I)=F{lt$(I)+'.00' 11380 P=INSTR(1,F{lt$(I),'.') 11390 IF LEN(F{lt$(I))>P+2 THEN F{lt$(I)=LEFT$(F{lt$(I),P+2) ! f|r m}nga decimaler 11400 ! v{rdet som lagras, kortas inte av, 11410 ! utan endast det som visas p} sk{rmen. 11420 IF LEN(F{lt$(I))=P+1 THEN F{lt$(I)=F{lt$(I)+'0' 11430 F{lt$(I)=STRING$(Length(I)-LEN(F{lt$(I)),95)+F{lt$(I) 11440 RETURN 11450 ! 11460 RESUME 11470 11470 PRINT CUR(I+3,4) '==>' 11480 Fel=True 11490 RETURN 11500 RESUME 11510 11510 RETURN False 11520 FNEND 11530 ! 11540 ! 12000 DEF FNPackaupp LOCAL Pos,Sv,Sv.,P,Posi,Skr{p$=1,Match 12010 Pos=1 12020 FOR I=1 TO Antalf{lt 12030 Temp$=MID$(Post$,Pos,L{ngd(I)) 12040 IF F{lttyp(I)>1 THEN GOSUB 12190 : GOTO 12140 12050 Posi=L{ngd(I) 12060 Skr{p$=RIGHT$(Temp$,Posi) 12070 WHILE Skr{p$=CHR$(32) AND Posi>0 12080 MID$(Temp$,Posi,1)='_' 12090 Posi=Posi-1 12100 IF Posi=0 THEN 12120 12110 Skr{p$=MID$(Temp$,Posi,1) 12120 WEND 12130 ! 12140 F{lt$(I)=Temp$ 12150 Pos=Pos+L{ngd(I) 12160 NEXT I 12170 RETURN True 12180 ! 12190 ! packa upp numeriska f{lt 12200 Match=False 12210 FOR J=1 TO LEN(Temp$) 12220 IF MID$(Temp$,J,1)<>'_' THEN Match=True 12230 NEXT J 12240 IF Match=False THEN Temp$=STRING$(Length(I),95) : RETURN 12250 ON F{lttyp(I)-1 GOTO 12260,12300,12300 12260 Sv=CVT$%(Temp$) 12270 Temp$=NUM$(Sv) 12280 Temp$=Temp$+STRING$(Length(I)-LEN(Temp$),95) 12290 RETURN 12300 ! flyttal 12310 Sv.=CVT$F(Temp$) 12320 Temp$=NUM$(Sv.) 12330 IF INSTR(1,Temp$,'.')=0 THEN Temp$=Temp$+'.00' 12340 P=INSTR(1,Temp$,'.') 12350 IF LEN(Temp$)>P+2 THEN Temp$=LEFT$(Temp$,P+2) 12360 IF LEN(Temp$)=P+1 THEN Temp$=Temp$+'0' 12370 Temp$=Temp$+STRING$(Length(I)-LEN(Temp$),95) 12380 RETURN 12390 FNEND 12400 ! 12410 ! 13000 DEF FNInp$(Text$,Leng) LOCAL Var$=160,Slask$=1 13010 Var$='' 13020 PRINT Text$+Var$+STRING$(Leng-LEN(Var$),95) Text$+Var$; 13030 GET Slask$ 13040 ON INSTR(1,CHR$(13,8,24),Slask$)+1 GOTO 13080,13050,13070,13010 13050 PRINT SPACE$(Leng-LEN(Var$)); 13060 RETURN Var$ 13070 IF LEN(Var$)>0 THEN Var$=LEFT$(Var$,LEN(Var$)-1) 13080 IF (ASCII(Slask$)>31 AND ASCII(Slask$)<128) THEN IF LEN(Var$)LEN(Name$) 14020 I=I+1 14030 IF ASCII(MID$(Name$,I,1))>95 AND ASCII(MID$(Name$,I,1))<127 THEN MID$(Name$,I,1)=CHR$(ASCII(MID$(Name$,I,1))-32) 14040 WEND 14050 RETURN Name$ 14060 FNEND 14070 ! 14080 ! 14090 DEF FNNyckelkoll(Q) LOCAL Tr{ff,Q1 14100 Q1=Nyckelkoll(Q) 14110 FOR I1=1 TO Antalf{lt 14120 Tr{ff=Tr{ff+L{ngd(I1) 14130 IF Tr{ff>Q1 THEN 14150 14140 NEXT I1 14150 RETURN I1 14160 FNEND 14170 ! 14180 ! 15000 DEF FN[ndra LOCAL Rad,Kol,Kod,Forts,Temp$=80 15010 Forts=FNInkontroll(False) 15020 IF Forts=False THEN 15070 15030 IF NOT FNPacka THEN Z=FNInfo(14) : Z=FNInfo(12) : GOTO 15010 15040 ON ERROR GOTO 15080 15050 ISAM UPDATE #1,Gammalpost$ TO Post$ 15060 PRINT CUR(22,5) '** UPPDATERAD **'; : GET P$ 15070 RETURN True 15080 RESUME 15090 15090 RETURN False 15100 FNEND 15110 ! 15120 ! 16000 DEF FNS|k LOCAL Slutflagga,Rader,Pos,Temp$=50,A$=50 16010 Slutflagga=False 16020 IF Postant=0 THEN Z=FNInfo(2) : Slutflagga=True 16030 WHILE NOT Slutflagga ! until PF1 is pressed 16040 Z=FNSudda(3,22) 16050 PRINT CUR(5,3) ']ter Meny PF1:' 16060 PRINT CUR(7,3) 'S|kning PF2:' 16070 PRINT CUR(9,3) 'Instruktioner PF3:' 16080 PRINT CUR(11,3) ']terf} sist raderade post PF4:' 16090 Z=FNPftangent(4,22,0) 16100 ON Z GOTO 16140,16170,16160,16110 16110 IF LEN(]nger$)<>0 THEN Z=FNSudda(5,11) : ; FNInmeny$ : GOTO 17830 16120 PRINT CUR(16,3) 'Ingen post {r raderad!' 16130 GOTO 16090 16140 Slutflagga=True 16150 GOTO 16030 16160 Z=FNText 16170 Z=FNSudda(3,22) 16180 PRINT CUR(4,5) 'S|kningen kan ske efter:' 16190 FOR I=1 TO Nyckelant 16200 PRINT CUR(I+5,5) Nyckel$(I) ' Alt: ' I 16210 NEXT I 16220 ON ERROR GOTO 16290 16230 PRINT TAB(6) 'Huvudnyckel, vilket alternativ '; 16240 INPUT P 16250 IF NOT (P>0 AND P<=Nyckelant) THEN 16230 16260 Index$=Nyckel$(P) 16270 Hu=FNNyckelkoll(P) 16280 GOTO 16310 16290 PRINT 'Svara med ett TAL!' 16300 RESUME 16220 16310 Nyckel$=FNInp$(CUR(18,5)+'Huvudnyckel: ',Nyckel(P)) 16315 A$=Nyckel$ 16320 IF Indextyp(P)>1 THEN ON Indextyp(P)-1 GOSUB 17970,18050,18050 16330 PRINT FNRad25$('Ingen hj{lpnyckel, tryck enbart Return.') 16340 PRINT TAB(6) 'Hj{lpnyckel, vilket alternativ '; 16350 INPUT P$ 16360 IF LEN(P$)=0 THEN Hj{lpnyckel$='' : GOTO 16420 16370 ON ERROR GOTO 16340 16380 P=VAL(P$) 16390 IF NOT (P>0 AND P<=Nyckelant) THEN 16340 16400 Hj=FNNyckelkoll(P) 16410 Hj{lpnyckel$=FNInp$(CUR(20,5)+'Hj{lpnyckel: ',Nyckel(P)) 16420 PRINT FNRad25$(SPACE$(80)) 16430 Z=FNSudda(3,22) 16440 Z=FNInfo(5) 16450 PRINT FNInmeny$ 16460 ON ERROR GOTO 16510 16470 ISAM READ #1,Post$ INDEX Index$ KEY Nyckel$ 16480 Z=FNPackaupp 16500 GOTO 16540 16510 IF ERRCODE=120 THEN Fel=10 ELSE Fel=9 16520 RESUME 17790 16530 ! 16540 ! kolla om hj{lpnyckel finns 16550 IF LEN(Hj{lpnyckel$)=0 THEN 16570 16560 IF INSTR(1,F{lt$(Hj),Hj{lpnyckel$)=0 THEN 16630 16570 ! skriv ut post p} sk{rm 16580 FOR I=1 TO Antalf{lt 16590 PRINT CUR(I+3,21) F{lt$(I) 16600 NEXT I 16610 GOTO 16700 ! delmeny 16620 ! l{s n{sta post 16630 ON ERROR GOTO 16670 16640 ISAM READ #1,Post$ NEXT 16650 Z=FNPackaupp 16660 IF INSTR(1,F{lt$(Hu),A$)=0 THEN Fel=10 : GOTO 17790 16670 GOTO 16550 ! kolla hj{lpnyckel 16680 IF ERRCODE=34 THEN Fel=10 ELSE Fel=9 16690 RESUME 17790 16700 ! 16710 Z=FNPftangent(6,1,70) 16720 ON Z GOTO 16750,16770,16840,16920,17000,17470 16730 ! 16740 WEND 16750 RETURN True 16760 ! 16770 ! -------------------- {ndra post ------------------- 16780 Z=FNInfo(12) 16790 Gammalpost$=Post$ 16800 IF NOT FN[ndra THEN Z=FNInfo(3) 16810 Z=FNInfo(5) 16820 GOTO 16570 16830 ! 16840 ! --------------------- f|reg}ende post ------------- 16850 ON ERROR GOTO 16890 16860 ISAM READ #1,Post$ PREVIOUS 16870 Z=FNPackaupp 16880 GOTO 16570 ! skriv post p} sk{rm 16890 IF ERRCODE=34 THEN Fel=6 ELSE Fel=9 16900 RESUME 17790 16910 ! 16920 ! --------------------- n{sta post ------------------ 16930 ON ERROR GOTO 16970 16940 ISAM READ #1,Post$ NEXT 16950 Z=FNPackaupp 16960 GOTO 16570 ! skriv post p} sk{rm 16970 IF ERRCODE=34 THEN Fel=7 ELSE Fel=9 16980 RESUME 17790 16990 ! 17000 ! --------------------- printer --------------------- 17010 Z=FNSudda(3,22) 17020 PRINT CUR(5,5) 'Alla poster med s|kta data kommer att skrivas p} printern.' 17030 PRINT CUR(7,5) 'Avbryt utskriften genom att trycka p} valfri tangent.' 17040 PRINT CUR(9,5) 'P}g}ende post skrivs f{rdigt.' 17050 ! 17060 Rader=7 : Sida=1 17070 ON ERROR GOTO 17430 17080 PREPARE 'PR:'+Printer$ AS FILE 10 17090 Z=FNHuvud(Sida) 17100 IF LEN(Hj{lpnyckel$)=0 THEN 17130 17110 PRINT #10 TAB(2) 'S|kta data: ' A$ ' och: ' Hj{lpnyckel$ 17120 GOTO 17140 17130 PRINT #10 TAB(2) 'S|kt data: ' A$ 17140 PRINT #10 STRING$(80,61) 17150 PRINT #10 17160 IF Typ<>4 THEN 17280 17170 IF LEN(Namn$(1))>Length(1) THEN Temp$=LEFT$(Namn$(1),Length(1)+1) ELSE Temp$=Namn$(1) 17180 IF Postlength<=80-((Antalf{lt-1)*2)-Tab1 THEN 17200 17190 PRINT #10,CHR$(F|rm) TAB(Tab1) Temp$; : GOTO 17210 17200 PRINT #10,TAB(Tab1) Temp$; 17210 Pos=Tab1+Length(1)+2 17220 FOR I=2 TO Antalf{lt 17230 IF LEN(Namn$(I))>Length(I) THEN Temp$=LEFT$(Namn$(I),Length(I)+1) ELSE Temp$=Namn$(I) 17240 PRINT #10,TAB(Pos) Temp$; 17250 Pos=Pos+Length(I)+2 17260 NEXT I 17270 PRINT #10 : Rader=Rader+2 17280 Slut=False 17290 WHILE Slut=False 17300 Rader=FNPrut(Typ,Rader) 17310 ISAM READ #1 Post$ INDEX Index$ NEXT 17320 Z=FNPackaupp 17350 IF LEFT$(F{lt$(Hu),LEN(A$))<>A$ THEN Slut=True 17360 IF SYS(5) THEN Slut=True 17362 IF LEN(Hj{lpnyckel$)=0 THEN 17370 17364 IF INSTR(1,F{lt$(Hj),Hj{lpnyckel$)=0 THEN 17370 17370 WEND 17380 ! 17390 PRINT #10. 17400 PRINT #10,CHR$(Norm) STRING$(80,61) 17410 CLOSE 10 17420 GOTO 16040 17430 IF ERRCODE=42 THEN Z=FNInfo(13) : RESUME 17420 17435 IF ERRCODE=21 THEN Z=FNInfo(16) : RESUME 17420 17440 IF ERRCODE<>34 THEN Z=FNInfo(9) : RESUME 17400 17450 RESUME 17400 17460 ! 17470 ! --------------------- radera post ----------------- 17480 Z=FNSudda(20,22) 17490 ! 17500 P$=FNInp$(CUR(21,5)+'Ska posten raderas (J/N) ??? ',1) 17510 P$=FNConv$(P$) 17520 IF P$='N' THEN Z=FNInfo(5) : GOTO 16570 ! }ter till delmeny 17530 IF P$<>'J' THEN ; CHR$(7) : GOTO 17500 17540 ! radering, men spar posten i ]nger$ 17550 ]nger$=Post$ 17560 ON ERROR GOTO 17770 17570 ISAM DELETE #1,Post$ 17580 Postant=Postant-1 17590 PRINT CUR(1,72) SPACE$(5) 17600 PRINT CUR(1,72) Postant 17610 OPEN 'DR1:DATA.ID' AS FILE 3 17620 PUT #3,CVT%$(Postant) 17630 CLOSE 3 17640 ! fyll Post$ med _ 17650 Post$=STRING$(LEN(Post$),95) 17660 Z=FNPackaupp 17670 Z=FNSudda(20,22) 17680 FOR I=1 TO Antalf{lt 17690 PRINT CUR(I+3,21) F{lt$(I) 17700 NEXT I 17710 PRINT CUR(21,5) 'Posten raderad, men kan }terf}s med CE eller CTRL-X' 17720 PRINT CUR(22,5) 'F|r forts{ttning tryck Return.'; 17730 GET P$ 17740 IF P$=CHR$(24) THEN 17830 ! }terf} posten 17750 Z=FNInfo(5) 17760 GOTO 16570 ! }ter till delmeny 17770 Fel=8 17780 RESUME 17790 17790 ! --------------------- fel ------------------------- 17800 Z=FNInfo(Fel) 17810 GOTO 16040 17820 ! 17830 ! ----------- }terf} raderad post ------------------- 17840 ON ERROR GOTO 17950 17850 Post$=]nger$ 17860 Z=FNPackaupp 17870 ISAM WRITE #1,Post$ 17880 Z=FNInfo(5) 17890 Postant=Postant+1 17900 PRINT CUR(1,72) Postant 17910 OPEN 'DR1:DATA.ID' AS FILE 3 17920 PUT #3,CVT%$(Postant) 17930 CLOSE 3 17940 GOTO 16570 ! }ter delmeny 17950 Fel=15 : RESUME 17790 17960 ! 17970 ! search for integer 17980 ON ERROR GOTO 18020 17990 Z=VAL(Nyckel$) 18000 Nyckel$=CVT%$(Z) 18010 RETURN 18020 RESUME 18010 18030 ! 18040 ! search for float 18050 ON ERROR GOTO 18090 18060 Z.=VAL(Nyckel$) 18070 Nyckel$=CVTF$(Z.) 18080 RETURN 18090 RESUME 18080 18100 ! 18110 FNEND 18120 ! 18130 ! 19000 DEF FNText LOCAL Text$=80 19010 OPEN 'register.txt' AS FILE 4 19020 Z=FNSudda(3,22) 19030 PRINT CUR(4,0); 19040 ON ERROR GOTO 19090 19050 WHILE 1 19060 INPUT #4,Text$ 19070 PRINT Text$ 19080 WEND 19090 PRINT CUR(22,58); : INPUT 'Tryck Return >>'P$ 19100 CLOSE 4 19110 RESUME 19120 19120 RETURN True 19130 FNEND 19140 ! 19150 ! 19160 ! 25000 ! ******************** huvudprogram ******************** 25010 PRINT CHR$(12) 25020 PRINT FNRad25$(SPACE$(80)) 25030 PRINT FNRam$ 25040 IF NOT FNOpenisam THEN Z=FNInfo(1) : Ej=-1 : GOTO 25060 25050 Z=FNInit 25060 Z=FNSudda(3,22) 25070 PRINT FNMeny$ 25080 V{lj=FNPftangent(5,23,0) 25090 IF V{lj>1 THEN 25120 25100 CLOSE 25110 CHAIN 'MENY' 25120 Z=FNSudda(3,22) 25130 ON V{lj-1 GOTO 25140,25150,25160,25170 25140 IF Ej THEN 25060 ELSE Z=FNInmatning : GOTO 25060 25150 IF Ej THEN 25060 ELSE Z=FNS|k : GOTO 25060 25160 IF Ej THEN 25060 ELSE Z=FNListning : GOTO 25060 25170 IF Ej THEN 25060 ELSE Z=FNPrinter : GOTO 25060 25180 ! 25190 ! ******************************************************