ADRES DEFTERİ

• BASIC
• Ofis programları
• Program dökümü

Merhaba, bu ay basit bir adres defteri programımız var. Sizlerden gelen sorulardan anladığım kadarıyla Basic programların özellikle dosya işlemleri konusunda zorluk çekiyorsunuz. İşte bu programımız bu konuda zorluk çeken okuyucularımız için iyi bir kılavuz olacak.

Sayın CENGİZ İLERLER iste BASİC’te dosyaya yazma ve okuma için istediğiniz örnek. 
Umarız yararlı olur. 
PALETTE 0,0,0,0 
PALETTE 1,0,5,0 
PALETTE 2..6.0.0 
PALETTE 3.0.0.1 
WINDOW 1, "LISTE",,4 
DIM a$(5),b$(5),c$(5),d$(5),c(5) 
c$(l)="ADI    :":c(l)=15 
cS(2)="SOYADI :":c(2)=15 
c$(3)="TELEFON:":c(3)=!2 
c$(4)="ADRESI :":c(4)=65 
cS(5)="NOT   :":c(5)=65 
ms=l 
KEYS$=,,l234567890QWERTYUIOPASDFGHJKLZXCVBNM.,;:'?/"+CHR$(l3)+CHR$(8) +CHR$(27) 
OPEN "R",#l,"ram:defter",172 
FIELD #1,15 AS ad$,15 AS sad$,12 AS tel$,65 AS adr$,65 AS NTS 
anamenu: 
pal=l 
eks=-.0l 
CLS:LINE (20*8,6*8-1 )-(55*8,14*8),2,b

LINE (20*8,3*8)-(55*K,6*8-2),3,b 
COLOR 2,0:LOCATE 5,29:PRINT "ADRES DEFTERİ" 
GOSUB okbas

LOCATE 8,29:PRINT "KAYIT ARAMA-DEG1STIRME" 
LOCATE 9,29:PRINT "YENİ KAYIT" 
LOCATE I0,29:PRINT "LOAD" 
LOCATE ll,29:PRINT"SAVE" 
I ,OCATE 12,29:PRINT "ABOUT THIZ PROGRAM" 
LOCATE I3.29:PRINT "CIKIS" 
menkeys: 
d$=INKEY$:GOSUB fade:IF d$=""THEN menkeys

IF d$=CHR$(l3) THEN PALETTE 3,0.0,.7:GOTO selected 
IF(d$=CHR$(28) AND ms<=l) OR (d$=CHR$(29) AND ms>=6) THEN menkevs 
IFd$=CHR$(28) THEN ms=m.s-l:GOSUB okbas 
IFd$=CHR$(29) THEN ms=ms+l:GOSUB okbas 
GOTO menkeys 
okbas: 
COLOR 3,0

LOCATE ms+6.26: PR INT "  " 
LOCATE ms+7.26:PRINT "Æ" 
LOCATE ms+8,26:PRINT "   " 
COLOR 1.0

RETURN 
selected: 
CI.S 
ON ms GÖSUB kayitarama,ycnikayit,dload,dsave,.about,quil 
GOTO anamenu 
quit: 
CLS:WINDOW CLOSE 1:END 
kayitarama: 
COLOR 2.0

LOCATE 2.27.PRINT "KAYIT ARAMA BOLUMU":COLOR 3.0:PRINT STRING$(80."-") 
COLOR 1.0:st=0

FOR d= 1 TO 5

PRINT c$(d)::sn=c(d):GOSUB inhand 
a$(d)=in$:IF er=-l THEN RETURN 
NEXT d 
COLOR 3.0:PRINT STRING$(80."-"):PRINT :COLOR 2.0 
PRINT TAB(31)"BULUNANKAYIT":COLOR3.0:PRINT STRING$(80.";"):COLOR 1.0 
a=INT(LOF(l)/l72) 
FORs=l TO a:st=0

GET #l.s 
b$(1)=ad$

b$(2)=sad$

b$(3)=tel$ 
b$(4)=adr$ 
b$(5)=NT$

F0R d=l T0 5 
IF a$(d)=SPACE$(c(d)) THEN birs 
IF a$(d)=b$(d) THEN birs 
st=1 
birs: NEXT d 
IF st=0 THEN ekrbas 
birs2: NEXT s 
COLOR 2,0: 
LOCATE 13,29:PRINT "KAYIT BULUNAMADI!!!!    " 
wakey:IF INKEY$="" THEN wakey 
RETURN 
ekrbas:

a=INT(LOF(I)/172) 
GET #l,s 
b$(l)=ad$ 
b$(2)=sad$ 
b$(3)=tel$ 
b$(4)=adr$ 
b$(5)=NT$ 
LOCATE 13,30:PRINT "KAYIT SIRA NO:"s"   " 
FOR d=l TO 5

LOCATE 13+d, I :PRINT c$(d);SPACE$(c(d)) 
LOCATE 13+d,9:PRINTb$(d) 
NEXT d 
COLOR 3,0 
PRINT STRING$(80,"-""):COLOR 2,0 
PRINT "       CURSOR TUŞLARI İLE KAYIT SIRASI ILERI-GERI (Esc=CIKIS'" 
PRINT "       (Return=ARAMAYA DEVAM) (F-10 DEĞİŞTİRME) (Del=SILME)"' 
COLOR 1,0

MOVE: d$=INKEY$:IF d$=""THEN MOVE 
IF d$=CHR$(27) THEN RETURN 
IF d$=CHR$(30) AND s<a THEN s=s+l .GOTO ekrbas 
IF d$=CHR$(31) AND s> I THEN s=s-1 :GOTO ekrbas 
IF d$=CHR$(13) THEN GOTO birs2 
IF d$=CHR$(138) THEN değiştirme 
IF d$=CHR$(127) THEN silme 
GOTO MOVE 
değiştirme: 
FOR d=l TO 5:b$(d)=a$(d):NEXT d.COLOR 2,0 
a=s-1:LOCATE 2,27:PRINT "KAYIT DEĞİŞTİRME BOLUMU":PRINT .GOSUB change 
FOR d=l TO 5:a$(d)=b$(d):NEXTd:COLOR 2,0 
LOCATE 2,27:PRINT "KAYIT ARAMA BOLUMU      '.PRINT :COLOR 1,0:GOTO ekrbas 
silme: 
a=s-1

FOR d=l T0 5:b$(d)=a$(d):a$(d)="|BOS|"":NEXTd 
GOSUB yerleştir 
FOR d=l TO 5:a$(d)=b$(d):NEXT d 
GOTO ekrbas 
yenikayit: 
a=INT(LOF( I )/l 72):COLOR 2,0 
LOCATE 2,27:PRINT "YENİ KAYIT BOLUMU'.COLOR 3,0:PRINT STRING$(80,'"-") 
change: 
COLOR 1,0 
FOR d=1 TO 5

PRINT c$(d);:sn=c(d):GOSUB inhand 
a$(d)=in$:IF er=-l THEN RETURN 
NEXT d 
yerleştir: 
LSET ad$=a$(I) 
LSET sad$=a$(2) 
LSET tel$=a$(3) 
LSET adr$=a$(4) 
LSET NT$=a$(5) 
PUT #l,a+l 
RETURN 
inhand:

inS=""' 
x=POS(0):y=CSRLIN:LOCATE y.x:PRINT "_"

reset:

i$=INKEY$:IF i$="" THEN reset 
iS=UCASE$(i$) 
IF INSTR(KEYS$.i$)=0 THEN reset 
IF i$=CHR$( 13) THEN er=0:LOCATE y.x 
PRINT " 
":r$=SPACE$(sn):MlD$(r$. I)=in$:in$=r$:RETURN 
IF i$=CHR$(8) AND LEN(in$)=0 THEN reset 
IF i$=CHR$(8) THEN in$=LEFT$(in$.LEN(in$)-1 ):x=x-l .LOCATE y.x:PRINT "_ ":GOTO reget 
IF i$=CHR$(27) THEN er=-1 :LOCATE y.x:PRlNT " ":RETURN 
IF LEN(in$)=sn THEN reset 
LOCATE y.x:PRINT i$"_":x=x+l:in$=in$+i$:GOTO reget

dload: 
COLOR 2.0 
LOCATE 2.3LPRINT "LOADER BOLUMU":COLOR 3.0:PRINTSTRING$<80."-") 
COLOR 1.0

PRINT :PRINT :LOCATE 10.20:PRINT "LÜTFEN BEKLEYIN. TRANSFER YAPIYORUM!" 
OPEN "r".#2."df0:defter".172

FIELD #2.15 AS tad$.15 AS tsad$.12 AS ttel$.65 AS tadr$,65 AS tnot$ 
FOR d=l TO INT(L0F(2)/I72) 
GET #2.d 
LSET ad$=tad$ 
LSET sad$=tsad$ 
LSET tel$=ttel$ 
LSET adr$=tadr$ 
LSET NT$=tnot$ 
PUT # 1.d 
NEXT d 
CLOSE #2 
PRINT :PR1NTTAB(27)"L0ADING BITTII!!" 
RETURN

dsave: 
COLOR 2.0 
LOCATE 2.31 :PRINT "SAVE BOLUMU":COLOR 3.0:PRINT STRING$(80,"-") 
COLOR 1.0 
PRINT PRINT :LOCATE l0,20:PRINT "LÜTFEN BEKLEYIN. TRANSFER YAPIYORUM!" 
OPEN "r",#2."df0:defter", 172 
FIELD #2,15 AS tad$J5 AS tsad$J2 AS ttcl$,65 AS tadr$,65 A> tnot$ 
FOR d=l TO INT(LOF(l)/172) 
GET # 1,d

LSET tad$=ad$ 
LSET tsad$=sad$ 
LSET ttel$=tel$ 
LSET tadr$=adr$' 
LSET tnot$=NT$ 
PUT #2,d 
NEXT d 
CLOSE #2 
PRINT :PRINTTAB(27)"SAVING BITTI!!" 
RETURN 
about: 
PRINT "About:" 
PRINT "Programmer By Hüseyin YEŞİLBAŞ" 
PRINT "in 1991."- 
PRINT "Dedicated to Yasemin." 
PRINT "Special Thanx to all my friends & Bronx Members!!"

abkey: IF INKEY$="" THEN abkey 
RETURN

fade: 
pal=pal+eks 
IF pal>=l OR pal<=.5 THEN eks=-l*eks:GOTO fade 
PALETTE 3,0,0,pal 
RETURN