1 REM Ins{nd av Erik Wetterberg <5948> 1987-01-21 Diskett 2 ! 10 ! LIST MEDLEM.BAS 11 ! -------------- MEDLEM --------------- 20 ! hantering av medlemregister 30 ! anv{nder ISAM-filer, som m}ste skapas f|rst 40 ! Isam m}ste vara laddat 41 ! INFO i MEDLEM.INF 50 ! 60 ! utvecklat p} Facit DTC 2 70 ! anpassat (n}gorlunda) till ABC806 - men det 80 ! {r sv}rt med bristen p} mark|rflyttningstangenter 90 ! {ndra g{rna i FNInittang, d{r du ocks} kan anpassa 100 ! programmet f|r andra ABC-datorer 110 ! Erik Wetterberg <5948> 111 ! ----------------------------------------- 112 ! Kristoffer Eriksson <5357> 870627: 113 ! Rad 2800, 2810 {ndrade f|r {ven ABC 800M och 802, 114 ! Rad 2850 Del {ndrad till CTRL-D 115 ! Rad 575 underl{ttar omstart. 116 ! Rad 576,577 sl{cker rad 25 117 ! Rad 755,865 hindrad error vid s|kning i tomt register 118 ! Rad 1025,1026,1045, 1135,1140,1165 (1130 {ndrad) tar hand om Error 120 119 ! vid stegning i tomt register och efter s|kning av obefintlig post n{r en 120 ! raderad post visas. Kan g|ras p} flera andra s{tt som kanske skulle vara 121 ! mer konsekventa. Stegning kunde t ex sp{rras i dessa l{gen, och FIRST och 122 ! LAST kunda man ha som s{rskilda funktioner. 123 ! Rad 1480 {ndrad s} medlemsnr inte skrivs dubbelt 124 ! Rad 2685,2690 undviker BLK p} ABC800 som saknar den 125 ! Rad 135 f|r r{tt inladdning i BAS-form 128 ! 130 ! ----------------------------------------- 135 INTEGER : EXTEND 140 COMMON Klubb$=4 150 DIM Medlpost$=136 : Medlpost$=CHR$(255,255,255)+SPACE$(133) 160 DIM Persnr$=11,Mnamn$=0,Coadr$=0,Adr$=0,Postnr$=0,Padr$=0,Tele$=0,Fill255$=0 170 Adr=VARPTR(Medlpost$) 180 POKE VAROOT(Fill255$),3,0,Adr,SWAP%(Adr),3,0 190 POKE VAROOT(Mnamn$),30,0,Adr+15,SWAP%(Adr+15),30,0 200 POKE VAROOT(Coadr$),30,0,Adr+45,SWAP%(Adr+45),30,0 210 POKE VAROOT(Adr$),30,0,Adr+75,SWAP%(Adr+75),30,0 220 POKE VAROOT(Postnr$),5,0,Adr+105,SWAP%(Adr+105),5,0 230 POKE VAROOT(Padr$),16,0,Adr+110,SWAP%(Adr+110),16,0 240 POKE VAROOT(Tele$),10,0,Adr+126,SWAP%(Adr+126),10,0 250 DIM Mkodpost$=17,Mkod$=0,Datkod$=0 260 Adr=VARPTR(Mkodpost$) 270 POKE VAROOT(Mkod$),6,0,Adr+5,SWAP%(Adr+5),6,0 280 POKE VAROOT(Datkod$),6,0,Adr+11,SWAP%(Adr+11),6,0 290 True=(1=1) 300 PRINT CHR$(12) 310 Z=FNInittang 320 IF Klubb$<>SPACE$(LEN(Klubb$)) THEN GOTO 340 330 Klubb$=FNIntxt$("MEDLEMSREGISTER F\R: ",SPACE$(4)) 340 IF NOT FNInitfile(Klubb$) THEN Z=FNErr("Inget s}dant register !!") : GOTO 330 350 PRINT CUR(2,0) Klubb$ " MEDLEMSREGISTER"; 360 PRINT CUR(4,0) "NAMN:" CUR(4,40) "PERSNR:" CUR(4,60) "MEDLNR:"; 370 PRINT CUR(6,0) "CO:" CUR(6,40) "TEL:"; 380 PRINT CUR(8,0) "ADR:" CUR(8,40) "POSTNR:" CUR(8,54) "POSTADR:"; 390 Z=FNVisa 400 PRINT CUR(23,0); 410 GET Kom$ 420 ! ------------------- HUVUDSLINGA --------------- 430 WHILE Kom$<>Esc$ 440 IF Kom$=Pf$(1) THEN Z=FNSoekmedl 450 IF Kom$=Pf$(2) THEN Z=FNSoeknamn 460 IF Kom$=Pf$(4) THEN Z=FNSkapa(NOT True) 470 IF Kom$=Pf$(5) THEN Z=FNSkapa(True) 480 IF Kom$=Pf$(6) THEN Z=FNMkodupd 490 IF Kom$=Pf$(7) THEN Z=FNDele 500 IF Kom$=Pf$(8) THEN CHAIN "medlskrv" 510 IF Kom$=Fram$ THEN Z=FNFram("MNAMN") 520 IF Kom$=Back$ THEN Z=FNBack("MNAMN") 530 IF Kom$=Sfram$ THEN Z=FNFram("MEDLNR") 540 IF Kom$=Sback$ THEN Z=FNBack("MEDLNR") 550 PRINT CUR(23,0); 560 GET Kom$ 570 WEND 575 Klubb$="" 576 IF PEEK(39)=10 OR PEEK(39)=3 THEN OUT 56,6,57,25 ! ABC800,802 577 Rad25$=SPACE$(80) 580 END 590 ! ------------------------------ 600 DEF FNInitfile(In$) LOCAL Fil$=12 610 ON ERROR GOTO 710 620 Fil$=FNNoblank$(In$+"medl.ism") 630 ISAM OPEN Fil$ AS FILE 1 640 Fil$=FNNoblank$(In$+"mkod.ism") 650 ISAM OPEN Fil$ AS FILE 2 660 Aktind$="MEDLNR" 670 ISAM READ #1,Medlpost$ INDEX "MEDLNR" LAST 680 Medlnrmax=CVT$%(MID$(Medlpost$,4,2)) 690 RETURN True 700 RETURN NOT True 710 IF ERRCODE=34 THEN Medlnrmax=0 : RESUME 690 720 RESUME 700 730 FNEND 740 ! -------------- 750 DEF FNSoekmedl LOCAL Medlnr 755 IF Medlnrmax=0 THEN RETURN FNErr("Tomt register!") 760 Aktind$="MEDLNR" 770 ON ERROR GOTO 820 780 Medlnr=FNIntal("Medlem nr: ",CVT$%(MID$(Medlpost$,4,2)),1,Medlnrmax) 790 ISAM READ #1,Medlpost$ INDEX "MEDLNR" KEY CVT%$(Medlnr) 800 RETURN FNVisa 810 RETURN FNErr("Hittar ej medlem nr "+NUM$(Medlnr)+" !") 820 IF ERRCODE=120 THEN RESUME 810 830 PRINT "** FNSoekmedl error: " ERRCODE : STOP 840 FNEND 850 ! --------------------------------- 860 DEF FNSoeknamn LOCAL Lnamn$=4 865 IF Medlnrmax=0 THEN RETURN FNErr("Tomt register!") 870 Aktind$="MNAMN" 880 ON ERROR GOTO 930 890 Lnamn$=FNIntxt$("Namn: ",LEFT$(Mnamn$,4)) 900 ISAM READ #1,Medlpost$ INDEX "MNAMN" KEY Lnamn$ 910 RETURN FNVisa 920 RETURN FNErr("Hittar ej medlem "+Lnamn$+" !") 930 IF ERRCODE=120 THEN RESUME 920 940 PRINT "** FNSoeknamn error: " ERRCODE : STOP 950 FNEND 960 ! --------------------------------- 970 DEF FNFram(In$) LOCAL Lkey$=4 980 ON ERROR GOTO 1040 990 IF In$=Aktind$ THEN GOTO 1020 1000 IF In$="MNAMN" THEN Lkey$=LEFT$(Mnamn$,4) ELSE Lkey$=MID$(Medlpost$,4,2) 1010 ISAM READ #1,Medlpost$ INDEX In$ KEY Lkey$ : Aktind$=In$ 1020 ISAM READ #1,Medlpost$ INDEX In$ NEXT : RETURN FNVisa 1025 ISAM READ #1,Medlpost$ INDEX In$ FIRST : RETURN FNVisa 1026 ! 1030 RETURN FNErr("Inga fler medlemmar !!") 1040 IF ERRCODE=34 THEN RESUME 1030 1045 IF ERRCODE=120 THEN RESUME 1025 1050 PRINT "** FNFram error: " ERRCODE : STOP 1060 FNEND 1070 ! ---------------------------------- 1080 DEF FNBack(In$) LOCAL Lkey$=4 1090 ON ERROR GOTO 1160 1100 IF In$=Aktind$ THEN GOTO 1130 1110 IF In$="MNAMN" THEN Lkey$=LEFT$(Mnamn$,4) ELSE Lkey$=MID$(Medlpost$,4,2) 1120 ISAM READ #1,Medlpost$ INDEX In$ KEY Lkey$ : Aktind$=In$ 1130 ISAM READ #1,Medlpost$ INDEX In$ PREVIOUS : RETURN FNVisa 1135 ISAM READ #1,Medlpost$ INDEX In$ LAST : RETURN FNVisa 1140 ! 1150 RETURN FNErr("Inga fler medlemmar !!") 1160 IF ERRCODE=34 THEN RESUME 1150 1165 IF ERRCODE=120 THEN RESUME 1135 1170 PRINT "** FNBack error: " ERRCODE : STOP 1180 FNEND 1190 ! ----------------------------------- 1200 DEF FNVisa 1210 ON ERROR GOTO 1390 1220 Persnr$=MID$(Medlpost$,6,6)+"-"+MID$(Medlpost$,12,4) 1230 IF Medlnrmax=0 THEN Medlnr=0 ELSE Medlnr=CVT$%(MID$(Medlpost$,4,2)) 1240 ! ---------------- 1250 PRINT CUR(4,6) Mnamn$ CUR(4,48) Persnr$ CUR(4,68); 1260 PRINT USING "#####" Medlnr; 1270 PRINT CUR(6,6) Coadr$ CUR(6,48) Tele$; 1280 PRINT CUR(8,6) Adr$ CUR(8,48) Postnr$ CUR(8,62) Padr$; 1290 Rad=10 : Kol=0 : Eof=NOT True 1300 PRINT FNBlankkod$; 1310 ISAM READ #2,Mkodpost$ INDEX "MEDLNR" KEY CVT%$(Medlnr) 1320 WHILE NOT Eof AND Medlnr=CVT$%(MID$(Mkodpost$,4,2)) 1330 PRINT CUR(Rad,Kol) Mkod$ " " Datkod$; 1340 Rad=Rad+1 1350 IF Rad>20 THEN Kol=Kol+15 : Rad=10 1360 ISAM READ #2,Mkodpost$ NEXT 1370 WEND 1380 RETURN FNMsg("") 1390 IF ERRCODE=34 OR ERRCODE=120 THEN Eof=True : RESUME 1380 1400 PRINT "FNVisa error: " ERRCODE : STOP 1410 FNEND 1420 ! --------------------------------- 1430 DEF FNBlankkod$=CUR(10,0)+SPACE$(1120) 1440 ! --------------------------------- 1450 DEF FNSkapa(Inny) 1460 ON ERROR GOTO 1660 1470 IF Inny THEN Medlnrmax=Medlnrmax+1 : Medlnr=Medlnrmax ELSE Medlold$=Medlpost$ 1480 PRINT CUR(4,68); : PRINT USING "#####" Medlnr; 1490 Fltnr=1 1500 WHILE Fltnr<=7 1510 Mnamn$=FNTxtflt$(1,Mnamn$,4,6) 1520 IF Fltnr<1 THEN PRINT CHR$(7); : Fltnr=1 1530 Persnr$=FNTxtflt$(2,MID$(Medlpost$,6,6)+"-"+MID$(Medlpost$,12,4),4,48) 1540 Coadr$=FNTxtflt$(3,Coadr$,6,6) 1550 Tele$=FNTxtflt$(4,Tele$,6,48) 1560 Adr$=FNTxtflt$(5,Adr$,8,6) 1570 Postnr$=FNTxtflt$(6,Postnr$,8,48) 1580 Padr$=FNTxtflt$(7,Padr$,8,62) 1590 WEND 1600 Fill255$=CHR$(255,255,255) 1610 MID$(Medlpost$,4,2)=CVT%$(Medlnr) 1620 MID$(Medlpost$,6,6)=MID$(Persnr$,1,6) 1630 MID$(Medlpost$,12,4)=MID$(Persnr$,8,4) 1640 IF Inny THEN ISAM WRITE #1,Medlpost$ ELSE ISAM UPDATE #1,Medlold$ TO Medlpost$ 1650 RETURN FNVisa 1660 PRINT "FNSkapa error: " ERRCODE : STOP 1670 FNEND 1680 ! -------------------------------- 1690 DEF FNMkodupd LOCAL Rad,Kol 1700 ON ERROR GOTO 1960 1710 Rad=10 : Kol=0 1720 ISAM READ #2,Mkodpost$ INDEX "MEDLNR" KEY CVT%$(Medlnr) 1730 WHILE Medlnr=CVT$%(MID$(Mkodpost$,4,2)) 1740 Mkodold$=Mkodpost$ 1750 Fltnr=1 1760 WHILE Fltnr<=2 1770 Mkod$=FNTxtflt$(1,Mkod$,Rad,Kol) 1780 IF Fltnr<1 THEN PRINT CHR$(7); : Fltnr=1 1790 Datkod$=FNTxtflt$(2,Datkod$,Rad,Kol+7) 1800 WEND 1810 IF Mkod$=SPACE$(6) THEN ISAM DELETE #2,Mkodold$ ELSE IF Mkod$+Datkod$<>MID$(Mkodold$,4,12) THEN ISAM UPDATE #2,Mkodold$ TO Mkodpost$ 1820 Rad=Rad+1 1830 IF Rad>20 THEN Kol=Kol+15 : Rad=10 1840 ISAM READ #2,Mkodpost$ NEXT 1850 WEND 1860 Mkodpost$=CHR$(255,255,255)+CVT%$(Medlnr)+SPACE$(12) 1870 Mkod$=FNTxtflt$(0,Mkod$,Rad,Kol) 1880 WHILE Mkod$<>SPACE$(6) 1890 Datkod$=FNTxtflt$(0,Datkod$,Rad,Kol+7) 1900 ISAM WRITE #2,Mkodpost$ 1910 Rad=Rad+1 1920 IF Rad>20 THEN Kol=Kol+15 : Rad=10 1930 Mkod$=FNTxtflt$(0,Mkod$,Rad,Kol) 1940 WEND 1950 RETURN FNVisa 1960 IF ERRCODE=34 OR ERRCODE=120 THEN RESUME 1860 1970 PRINT "FNSkapa error: " ERRCODE : STOP 1980 FNEND 1990 ! --------------------------------- 2000 DEF FNDele 2010 ON ERROR GOTO 2110 2020 ISAM DELETE #1,Medlpost$ 2030 ISAM READ #2,Mkodpost$ INDEX "MEDLNR" KEY CVT%$(Medlnr) 2040 WHILE MID$(Mkodpost$,4,2)=CVT%$(Medlnr) 2050 ISAM DELETE #2,Mkodpost$ 2060 ISAM READ #2,Mkodpost$ INDEX "MEDLNR" KEY CVT%$(Medlnr) 2070 WEND 2080 Medlpost$=CHR$(255,255,255)+CVT%$(0)+SPACE$(131) 2090 Medlnr=0 2100 RETURN FNVisa 2110 IF ERRCODE=120 OR ERRCODE=34 THEN RESUME 2080 2120 PRINT "FNDele error: " ERRCODE : STOP 2130 FNEND 2140 ! --------------------------------- 2150 DEF FNTxtflt$(Innr,In$,Inrad,Inkol) LOCAL Lch$=1,Lnr,Ltxt$=80 2160 ! inl{sning av en textstr{ng 2170 IF Innr<>Fltnr AND Innr<>0 THEN RETURN In$ 2180 Ltxt$=SPACE$(80) 2190 MID$(Ltxt$,1,LEN(In$))=In$ 2200 Lnr=1 2210 PRINT CUR(Inrad,Inkol) MID$(Ltxt$,1,LEN(In$)); 2220 PRINT CUR(Inrad,Inkol+Lnr-1); 2230 GET Lch$ 2240 IF Lch$=Ret$ THEN Fltnr=Fltnr+1 : RETURN MID$(Ltxt$,1,LEN(In$)) 2250 IF Lch$=Upp$ THEN Fltnr=Fltnr-1 : RETURN MID$(Ltxt$,1,LEN(In$)) 2260 IF Lch$=Quit$ THEN Fltnr=99 : RETURN MID$(Ltxt$,1,LEN(In$)) 2270 IF Lch$=Del$ AND Lnr>1 THEN MID$(Ltxt$,Lnr-1,81-Lnr)=RIGHT$(Ltxt$,Lnr) : Lnr=Lnr-1 : GOTO 2210 2280 IF Lch$=Linedel$ THEN MID$(Ltxt$,1,LEN(In$))=SPACE$(LEN(In$)) : Lnr=1 : GOTO 2210 2290 IF Lch$=Back$ AND Lnr>1 THEN Lnr=Lnr-1 : GOTO 2220 2300 IF Lch$=Fram$ AND Lnr126 THEN PRINT CHR$(7); : GOTO 2230 2320 IF Lnr>LEN(In$) THEN PRINT CHR$(7); : GOTO 2230 2330 IF Lch$>CHR$(95) THEN Lch$=CHR$(ASCII(Lch$) AND NOT 32) 2340 PRINT Lch$; : MID$(Ltxt$,Lnr,1)=Lch$ 2350 Lnr=Lnr+1 : GOTO 2230 2360 FNEND 2370 ! 2380 DEF FNTalflt(Innr,In,Inrad,Inkol,Inmin,Inmax) LOCAL Ltxt$=5,Llen,Ltal 2390 ! inl{sning av ett heltal 2400 ON ERROR GOTO 2480 2410 Llen=LEN(NUM$(Inmax)) 2420 IF LEN(NUM$(Inmin))>Llen THEN Llen=LEN(NUM$(Inmin)) 2430 Ltxt$=FNTxtflt$(Innr,NUM$(In)+SPACE$(Llen-LEN(NUM$(In))),Inrad,Inkol) 2440 IF Ltxt$=SPACE$(Llen) THEN Ltal=0 ELSE Ltal=VAL(Ltxt$) 2450 IF Ltal>Inmax OR Ltal10 THEN PRINT WHT NWBG BLK; 2690 PRINT In$ SPACE$(40-LEN(In$)) BLBG WHT CUR(Rad,Kol); 2700 RETURN 0 2710 FNEND 2720 ! 2730 DEF FNInittang 2740 DIM Rad25$=0 : POKE VAROOT(Rad25$),0,80,32640,SWAP%(32640),0,80 2750 DIM Esc$=1,Ret$=1,Del$=1,Linedel$=1,Fram$=1,Back$=1,Sfram$=1,Sback$=1 2760 DIM Upp$=1,Quit$=1 2770 DIM Pf$(1:14)=1 2780 Pf$(1)=CHR$(192) : Pf$(2)=CHR$(193) : Pf$(3)=CHR$(194) : Pf$(4)=CHR$(195) 2790 Pf$(5)=CHR$(196) : Pf$(6)=CHR$(197) : Pf$(7)=CHR$(198) : Pf$(8)=CHR$(199) 2800 IF PEEK(39)<>3 AND PEEK(39)<>4 AND PEEK(39)<>10 THEN GOTO 2910 2810 ! ----- tangentkoder ABC 80X ---------------- 2820 OUT 56,6,57,25 2830 Rad25$="PF1:S|k nr 2:S|k namn 4:[ndra 5:Skapa 6:Koder 7:Bort 8:Skriv ShPF8:Avsluta" 2840 Esc$=CHR$(215) : Ret$=CHR$(13) 2850 Del$=CHR$(4) : Linedel$=CHR$(24) 2860 Fram$=CHR$(9) : Back$=CHR$(8) 2870 ! dessa tangenter {r ej v{lvalda. [ndra dem g{rna !! 2880 Sback$=CHR$(2) : Sfram$=CHR$(6) ! Shift-back=ctrl-B Shift-fram=ctrl-F 2890 Upp$=CHR$(21) : Quit$=CHR$(17) ! Upp=ctrl-U Quit=ctrl-Q 2900 RETURN 0 2910 IF PEEK(39)<>6 THEN GOTO 3000 2920 ! ----- tangentkoder Facit DTC 2 ------------ 2930 Rad25$="PF1:S|k nr 2:S|k namn 4:[ndra 5:Skapa 6:Koder 7:Bort 8:Skriv Esc:Avsluta" 2940 Esc$=CHR$(27) : Ret$=CHR$(13) 2950 Del$=CHR$(8) : Linedel$=CHR$(24) 2960 Fram$=CHR$(163) : Back$=CHR$(162) 2970 Sback$=CHR$(178) : Sfram$=CHR$(179) 2980 Upp$=CHR$(160) : Quit$=CHR$(10) 2990 RETURN 0 3000 PRINT CHR$(12)+"Programmet ej anpassat f|r denna dator"+CHR$(7) 3010 CHAIN "NUL:" 3020 FNEND 3030 ! ------------------------------------------------ 3040 DEF FNNoblank$(In$) LOCAL Pos 3050 Pos=INSTR(1,In$," ") 3060 IF Pos=0 RETURN In$ 3070 RETURN LEFT$(In$,Pos-1)+FNNoblank$(RIGHT$(In$,Pos+1)) 3080 FNEND 3090 ! ------------------------------------------------ 3100 DEF FNStrip$(In$) LOCAL Pos 3110 Pos=LEN(In$) 3120 WHILE Pos>0 AND MID$(In$,Pos,1)=" " 3130 Pos=Pos-1 3140 WEND 3150 RETURN LEFT$(In$,Pos) 3160 FNEND