|
Tuðgeneral
Üyelik tarihi: Apr 2007
Bulunduðu yer: VAN
Yaş: 38
Mesajlar: 924
|
depo kayýt(stok) programý
Program stok;
Uses CRT,DOS;
Type
datetimetype=string[8];
string79=string[30];
(*********** KAYIT DEGISKENLERI **************)
Kimlik=Record
seri : string[10] ;
no : string[10] ;
soyadi : string[13] ;
adi : string[13] ;
baba_adi : string[13] ;
ana_adi : string[13] ;
d : char ;
End;
Const
bell=7 ;
back_space=8 ;
carriage_return=13 ;
escape=27 ;
right_arrow=77 ;
Var
seri1 : string79 ;
no1 : string79 ;
soyadi1 : string79 ;
adi1 : string79 ;
rh1 : string79 ;
il1 : string79 ;
ara_adi1 : string79;
ara_soyadi1 : string79;
ara_baba_adi1 : string79;
ara_ana_adi1 : string79;
ara_cilt_no1 : string79;
ara_no1 :string79;
ara_soyaddi1 :string79;
ara_seri1 :string79;
ara_addi1 :string79;
ara_aile_sira_no1 : string79;
kod1 : string79;
Var
kayit : kimlik;
dosya : file of kimlik;
cevap : char;
devam : char;
tus : char;
i : integer;
j : integer;
kod2 : integer;
ara_adi : string[13];
ara_soyadi : string[13];
ara_baba_adi : string[13];
ara_ana_adi : string[13];
saat : datetimetype;
(************* EKRANA SAAT MESAJI ***************)
Function time :datetimetype;
var
reg:registers;
h,m,s,w:datetimetype;
begin
reg.ax:=$2c00;
intr($21,reg);
str(hi(reg.cx):2,h);
str(lo(reg.cx):2,m);
str(hi(reg.dx):2,s);
w:=h + ':' + m ;
for i:=i to length(w) do if w[i]=' ' then w[i]:='0';
time:=w;
end;
(***********************************************)
Procedure Set_video(attribute:integer);
Var
blinking,bold:integer;
Begin
blinking:=(attribute and 4)*4;
if (attribute and 12)=11 then
begin
bold:=(attribute and 2)*7;
Textcolor(1+blinking+bold);
Textbackground(0);
end
else
begin
bold:=(attribute and 2)*5 div 2;
Textcolor(14+blinking);
Textbackground(0);
end;
End;
(************************************************)
Procedure put_string(out_string:string79;line,col,attrib:int eger);
Begin
set_video(attrib);
gotoxy(col,line);
write(out_string);
set_video(1);
End;
(************************************************)
Procedure Get_string(var in_string:string79;
line,col,attrib,str_length:integer);
Var
oldstr : string79 ;
in_char : char ;
i : integer ;
Begin
oldstr:=in_string;
put_string(in_string,line,col,attrib);
for i:= length(in_string) to str_length-1 do
put_string(' ',line,col+i,attrib);
gotoxy(col,line);
in_char:=readkey;
if ord(in_char)<>carriage_return then
in_string:='';
while ord(in_char)<>carriage_return do
begin
if ord(in_char)=back_space then
begin
if length(in_string)>0 then
begin
in_string[0]:=chr(length(in_string)-1);
write(chr(back_space));
write(' ');
write(chr(back_space));
end;
end
else
if ord(in_char)=escape then
begin
in_char:=readkey;
if ord(in_char)=right_arrow then
begin
if length(oldstr)>length(in_string) then
begin
in_string[0]:=chr(length(in_string)+1);
in_char:=oldstr[ord(in_string[0])];
in_string[ ord(in_string[0])]:=in_char;
write(in_char);
end;
end
else
write(chr(bell));
end
else
if length(in_string)<str_length then
begin
in_string[ 0]:=chr(length(in_string)+1);
in_string[ord(in_string[0])]:=in_char;
write(in_char);
end
else
write(chr(bell));
in_char:=readkey;
end;
put_string(in_string,line,col,attrib);
for i:= length(in_string)to str_length-1 do
put_string(' ',line,col+i,0);
End;
(**************** KIMLIK EKRANI *****************)
Procedure Kimlik_menu;
Begin
Clrscr;
TEXTCOLOR(RED);
GOTOXY(10,1); write('ÉÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ ÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ»');
GOTOXY(10,2); write('º <<<KAYIT GIRIS MENšSš>>> º');
GOTOXY(10,3); write('º º');
GOTOXY(10,4); write('ÌÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍËÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ ÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ͹');
GOTOXY(10,5); write('º URUN ADI º º');
GOTOXY(10,6); write('º º º');
GOTOXY(10,7); Write('ÌÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ͹ º');
GOTOXY(10,8); write('º URUN NO º º');
GOTOXY(10,9); write('º º º');
GOTOXY(10,10); write('ÌÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ͹ º');
GOTOXY(10,11); write('º URUN CINSI º º');
GOTOXY(10,12); write('º º º');
GOTOXY(10,13); write('ÌÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ͹ º');
GOTOXY(10,14); write('º URUN TARIHI º º');
GOTOXY(10,15); write('º º º');
GOTOXY(10,16); write('ÌÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ͹ º');
GOTOXY(10,17); write('ÈÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÊÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ ÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍͼ');
End;
(************** KURSOR AKTIF-PASIF **************)
Procedure kursor(m:boolean);
Var
r:registers;
Begin
case m of
true: begin
r.ch:=0 ;
r.cl:=14;
end;
false: begin
r.ch:=31;
r.cl:=0 ;
end;
end;
r.ah:=1;
r.al:=0;
intr($10,r);
End;
(***************** ZEMIN RENGI ******************)
Procedure zeminrengi(t:byte);
Begin
Textbackground(t);
for i:=1 to 25 do Write('':10);
End;
(*************** PENCERE ICI RENGI **************)
Procedure prengi(renk:byte);
Begin
Textbackground(renk);
for j:=3 to 23 do Write(' ':78);
End;
(******************* CERCEVE ********************)
Procedure Cerceve(x1,y1,x2,y2:byte);
Var
k:byte;
Begin
Gotoxy(x1,y1);Write(#201);
for k:=x1+1 to x2-1 do Write (#205);
Write(#187);
for k:= y1+1 to y2-1 do
begin
Gotoxy(x1,k);Write(#186);
Gotoxy(x2,k);Write(#186);
end;
Gotoxy(x1,y2);Write(#200);
for k:=x1+1 to x2-1 do Write(#205);
Write(#188);
End;
(************* CIKISTA EKRANA MESAJ *************)
Procedure Cikis_menu;
Begin
clrscr;
Textcolor(0);
Cerceve(1,1,80,24);
Textcolor(0);
delay(50);Gotoxy(3,8);Writeln('D');
delay(150);Gotoxy(4,8);Writeln('E');
delay(50);Gotoxy(5,8);Writeln('P');
delay(150);Gotoxy(6,8);Writeln('O');
delay(50);Gotoxy(7,8);Writeln(' ');
delay(150);Gotoxy(8,8);Writeln('K');
delay(50);Gotoxy(9,8);Writeln('A');
delay(150);Gotoxy(10,8);Writeln('Y');
delay(50);Gotoxy(11,8);Writeln('I');
delay(150);Gotoxy(12,8);Writeln('T');
delay(50);Gotoxy(13,8);Writeln(' ');
delay(150);Gotoxy(14,8);Writeln('A');
delay(50);Gotoxy(15,8);Writeln('Y');
delay(150);Gotoxy(16,8);Writeln('G');
delay(50);Gotoxy(17,8);Writeln('U');
delay(150);Gotoxy(18,8);Writeln('N');
delay(50);Gotoxy(19,8);Writeln(' ');
delay(150);Gotoxy(20,8);Writeln('P');
delay(50);Gotoxy(21,8);Writeln('R');
delay(50);Gotoxy(22,8);Writeln('O');
delay(150);Gotoxy(23,8);Writeln('.');
delay(50);Gotoxy(24,8);Writeln('.');
delay(150);Gotoxy(25,8);Writeln('.');
delay(50);Gotoxy(26,8);Writeln('.');
delay(150);Gotoxy(27,8);Writeln('.');
DELAY(150);Gotoxy(3,9);Writeln('V');
DELAY(50);Gotoxy(4,9);Writeln('E');
DELAY(50);Gotoxy(5,9);Writeln('R');
DELAY(50);Gotoxy(6,9);Writeln('S');
DELAY(50);Gotoxy(7,9);Writeln('I');
DELAY(50);Gotoxy(8,9);Writeln('Y');
DELAY(150);Gotoxy(9,9);Writeln('O');
DELAY(150);Gotoxy(10,9);Writeln('N');
DELAY(50);Gotoxy(11,9);Writeln(' ');
DELAY(50);Gotoxy(12,9);Writeln('2');
DELAY(50);Gotoxy(13,9);Writeln('.');
DELAY(150);Gotoxy(14,9);Writeln('1');
Gotoxy(3,11);Writeln('AYGUN YAZILIM ');
GOTOXY(15,18);WRITELN('COPRIHT(c) GOKHAN AYGUN...');
Textcolor(red);
Gotoxy(13,21); Writeln('BIZI TERCIH ETTGINIZ ICIN TESEKKURLER');
Gotoxy(1,25) ;
Kursor(false);
readln;
End;
(***************** ANA CERCEVE ******************)
Procedure Ana_cerceve;
Const
gunler:Array [0..6] of string[8]=('Pazar','P.tesi','Sali',
'Carsamba','Persembe','Cuma','C.tesi');
Var
yil,ay,gun,gn:word;
Begin
clrscr;
Textcolor(4);
cerceve(1,1,80,24);
Textcolor(1); Textbackground(15);
for i:=2 to 79 do
begin
Gotoxy(i,2); Writeln(' ':1);
Gotoxy(i,23);Writeln(' ':1);
end;
Textcolor(1);
Gotoxy(2,2);Write('URUN KAYIT PROGRAMI 1.00 2004-2005 ');
Textcolor(0);
Textbackground(2);
getdate(yil,ay,gun,gn);
Textcolor(0);
Textbackground(2);
getdate(yil,ay,gun,gn);
Gotoxy(60,2);Write(gun:0,'/',ay:0,'/',yil:0,' ',Gunler[gn]);
i:=0;
saat:=time;
Gotoxy(50,2);Write(saat);
Textcolor(128+0);Gotoxy(52,2);Write(':');
End;
(************* GIRISTEN KAYIT OKUMA *************)
Procedure Kayit_oku;
Begin
kursor(true);
Textcolor(5);
Textbackground(1);
get_string(seri1,6,40,10,10);
kayit.seri:=seri1;
get_string(no1,9,40,10,10);
kayit.no:=no1;
get_string(soyadi1,12,40,10,10);
kayit.soyadi:=soyadi1;
get_string(adi1,15,40,10,10);
kayit.adi:=adi1;
End;
(************** EKRANA KAYIT YAZMA **************)
Procedure Kayit_yaz;
Begin
Textcolor(2);
Gotoxy(35,6) ; Write(kayit.seri) ;
Gotoxy(35,9) ; Write(kayit.no) ;
Gotoxy(35,12) ; Write(kayit.soyadi) ;
Gotoxy(35,15) ; Write(kayit.adi) ;
End;
(***************** EVET HAYIR *******************)
Procedure Evethayir(i,j,k,l:byte);
Begin
Textcolor(14); Gotoxy(i,j) ; Write('E') ;
Textcolor(5) ; Gotoxy(i+1,j); Write('VET ') ;
Textcolor(14); Gotoxy(k,l) ; Write('H') ;
Textcolor(5) ; Gotoxy(k+1,l); Write('AYIR') ;
End;
(**************** ALAN BOSALTMA ****************)
Procedure alan_bosalt;
Begin
seri1 := ' ' ; kayit.seri := seri1 ;
no1 := ' ' ; kayit.no := no1 ;
soyadi1 := ' ' ; kayit.soyadi := soyadi1 ;
adi1 := ' ' ; kayit.adi := adi1 ;
End;
(********************* GIRIS ********************)
Procedure Giris;
Begin
Repeat
Textcolor(4); Textbackground(3);
Gotoxy(4,23); Write('URUN KAYIT GIRIS PROGRAMI ',' VERSIYON 1.0');
Window(2,3,79,22);
Prengi(1);
Alan_bosalt ;
Kimlik_menu ;
Kayit_oku ;
Textcolor(14) ; Textbackground(5);
Gotoxy(25,19) ; Writeln('GIRILEN KAYIT DOGRU MU?');
Evethayir(49,19,54,19);
Repeat
Kursor(false);
Cevap := Upcase(Readkey);
Until Cevap in ['E','H'];
If Cevap='E' Then
Begin
kayit.d:='*';
Seek (Dosya,Filesize(dosya));
Write (Dosya,Kayit);
Repeat
Textcolor(14);
Gotoxy(30,18); Write('GIRIS ISLEMI TAMAMLANDI...');
Textcolor(128+15);
Gotoxy(20,19);
Write('ANA MENUYE DONMEK ICIN <<Esc>> TUSUNA BASINIZ...');
Tus:=readkey;
Until tus in [#27];
Window(1,1,80,25);
Exit;
End;{if}
Textcolor(14);
Gotoxy(23,19); Write('KAYDI YENIDEN GIRECEK MISINIZ?');
Evethayir(54,19,59,19);
Repeat
Devam := Upcase(Readkey);
Until Devam in ['E','H'];
Until Devam in ['H'];
Textcolor(128+15);
Gotoxy(18,19);
Write('ANA MENUYE DONMEK ICIN <<Esc>> TUSUNA BASINIZ...');
Repeat
Tus:=Readkey;
Until tus=#27;
Window(1,1,80,25);
Exit;
End; {ana}
(********************* ARAMA ********************)
Procedure Arama;
Begin
Repeat
Kursor(true);
Textcolor(4); Textbackground(7);
Gotoxy(3,23); Write('URUN KAYIT ARAMA');
Window(2,3,79,22);
Prengi(1);
Kimlik_menu;
Textcolor(YELLOW);
Gotoxy(23,2); Write(' <<< URUN KAYIT ARAMA MENšSš >>>');
Textcolor(15);
ara_seri1 :=' ';
Get_string(ara_seri1,5,39,0,13) ;ara_seri1 :=ara_seri1 ;
For i:=0 to filesize(dosya)-1 do
Begin
Seek (dosya,i);
Read (dosya,kayit);
If (kayit.d='*') and (kayit.seri=ara_seri1)
then
Begin
Prengi(1);
Kimlik_menu;
Kayit_yaz;
Textcolor(14);
Gotoxy(24,19); Write('ARADIGINIZ KAYIT BU MU?');
Evethayir(49,19,54,19);
Repeat
Kursor(false);
Cevap :=Upcase(Readkey);
Until Cevap in ['E','H'];
If Cevap='E' then begin
Repeat
Textcolor(14);
Gotoxy(30,18); Write('ARAMA ISLEMI TAMAMLANDI...');
Textcolor(128+15);
Gotoxy(20,19);
Write('ANA MENUYE DONMEK ICIN <<Esc>> TUSUNA BASINIZ...');
Tus:=Readkey;
Until Tus=#27;
Window(1,1,80,25);
Exit;
end;{if}
end;{if}
end;{for}
Prengi(1);
Textcolor(10);
Cerceve(20,10,60,14);
Gotoxy(22,12);
Write('DOSYADA BOYLE BIR KAYIT MEVCUT DEGIL!');
Textcolor(14);
Gotoxy(13,19);
Write('ARAMA ISLEMINI TEKRAR DENEYECEK MISINIZ?');
Evethayir(54,19,59,19);
Repeat
Kursor(false);
Devam:= Upcase(Readkey);
Until Devam in ['E','H'];
Until Devam in ['H'];
Gotoxy(12,19);Clreol;
Gotoxy(17,19);
Textcolor(128+15);
Write('ANA MENUYE DONMEK ICIN <<Esc>> TUSUNA BASINIZ...');
Repeat
Tus:=Readkey;
Until Tus=#27;
Window(1,1,80,25);
Exit;
End;{ana}
(**************** DUZELTME MENUSU ***************)
Procedure Duzeltme_menusu;
Begin
Assign(Dosya,'C:\Kimlik.dat');
{$I-}
Reset(dosya);
{$I+}
If ioresult <> 0 then Rewrite(dosya);
Textcolor(YELLOW);
Textbackground(1);
Gotoxy(60,5) ; Writeln('=> 1 <=') ;
Gotoxy(60,8) ; Writeln('=> 2 <=') ;
Gotoxy(60,11) ; Writeln('=> 3 <=') ;
Gotoxy(60,14) ; Writeln('=> 4 <=') ;
Textcolor(14);
Gotoxy(21,19) ; Write('DUZELTILECEK BILGININ KODUNU GIR :[ ]');
Repeat
Kursor(true);
kod1:=' ';
Get_string(kod1,19,56,1,2);
Val(kod1,kod2,i);
Case kod2 of
1: begin
seri1:=' ';
Get_string(seri1,6,40,10,10);
kayit.seri:=seri1;
end;
2:begin
no1:=' ';
Get_string(no1,9,40,10,10);
kayit.no:=no1;
end;
3: begin
soyadi1:=' ';
Get_string(soyadi1,12,40,10,10);
kayit.soyadi:=soyadi1;
end;
4: begin
adi1:=' ';
Get_string(adi1,15,40,10,10);
kayit.adi:=adi1;
end;
end;
Until kod2 in[1,2,3,4];
End;
(******************* DUZELTME *******************)
Procedure Duzeltme;
Begin
Repeat
Kursor(true);
Textcolor(4) ;
Textbackground(7) ;
Gotoxy(3,23) ;
Write('URUN KAYIT DšZELTME');
Window(2,3,79,22) ;
Prengi(1) ;
kimlik_menu;
TEXTCOLOR(YELLOW);
gotoxy(26,2);write('<<< šRšN DšZELTME MENšSš >>>');
Textcolor(15);
ara_seri1 := '' ;
Get_string (ara_seri1,6,39,0,13) ;ara_seri1 :=ara_seri1 ;
For i:=0 to filesize(dosya)-1 do
Begin
Seek (dosya,i) ;
Read (dosya,kayit) ;
If (kayit.d='*') and (kayit.seri=ara_seri1)
then
begin
Prengi(1) ;
Kimlik_menu ;
Kayit_yaz ;
Textcolor(14);
Gotoxy(21,19); Write('DUZELTILECEK KAYIT BU MU?');
Evethayir(47,19,52,19);
Repeat
Kursor(false);
Cevap:= Upcase(Readkey) ;
until Cevap in ['E','H'] ;
If Cevap='E' then begin
Repeat
Duzeltme_menusu;
Kursor(false);
Seek (dosya,i) ;
Write (dosya,kayit) ;
Textcolor(14);
Textbackground(1);
Gotoxy(21,19);
Write('DUZELTILECEK BASKA BILGI VAR MI?');
Evethayir(54,19,59,19);
Repeat
Devam:= Upcase(Readkey);
Until Devam in ['E','H'];
if Devam='E' then Gotoxy(21,19); Clreol;
if Devam='H' then Gotoxy(21,19); Clreol;
Until Devam in ['H'];
Repeat
Textcolor(14);
Gotoxy(27,18);
Write('DUZELTME ISLEMI TAMAMLANDI...');
Textcolor(128+15);
Gotoxy(24,19);
Write('ANA MENUYE DONMEK ICIN <<Esc>> TUSUNA BASINIZ...');
Tus:= Readkey;
Until Tus=#27;
Window(1,1,80,25) ;
Exit ;
end;
end;
end;{for}
Prengi(1);
Textcolor(10);
Cerceve(20,10,60,14);
Gotoxy(22,12);
Write('BOYLE BIR KAYIT DOSYADA MEVCUT DEGIL!');
Textcolor(14);
Gotoxy(15,19);
Write('DUZELTME ISLEMINI TEKRAR DENEYECEK MISINIZ?');
Evethayir(59,19,64,19);
Repeat
Kursor(false);
Devam:= Upcase(Readkey);
Until Devam in ['E','H'];
Until devam in ['H'];
Gotoxy(15,19);Clreol;
Textcolor(128+15);
Gotoxy(17,19);
Write('ANA MENUYE DONMEK ICIN <<Esc>> TUSUNA BASINIZ...');
Repeat
Tus:=readkey;
Until tus=#27;
Window(1,1,80,25);
Exit;
End;{ana}
(****************** LISTELEME *******************)
Procedure Listeleme;
Var
s:integer;
Begin
Textcolor(4) ;
Textbackground(7) ;
Gotoxy(3,23); Write('URUN KAYIT LISTELEME');
Window(2,3,79,22);
Prengi(1);
s:=5;
For i:=0 to filesize(dosya)-1 do
Begin
Seek (dosya,i);
Read (dosya,kayit);
If (kayit.d='*') then
begin
Textcolor(15);
Gotoxy(6,2);
Write('ÉÍÍÍÍÍÍÍÍÍÍÍÍÍËÍÍÍÍÍÍÍÍÍÍÍÍÍËÍÍÍÍÍÍÍÍÍÍÍÍÍË ÍÍÍÍÍÍÍÍÍÍÍÍÍÍ»');
Gotoxy(6,3);
Write('º URUN ADI º URUN NO º URUN CINSI º URUN TARIHI º');
Gotoxy(6,4);
Write('ÌÍÍÍÍÍÍÍÍÍÍÍÍÍÎÍÍÍÍÍÍÍÍÍÍÍÍÍÎÍÍÍÍÍÍÍÍÍÍÍÍÍÎ ÍÍÍÍÍÍÍÍÍÍÍÍÍ͹');
Gotoxy(6,s);
Write( kayit.SERI:10, kayit.NO:13, kayit.SOYADI:19,kayit.adi:15);
gotoxy(6,s);write('º');
gotoxy(20,s);write('º');
gotoxy(34,s);write('º');
gotoxy(48,s);write('º');
gotoxy(63,s);write('º');
s:=s+1;
If s>=16 then
begin
Gotoxy(20,18);
Textcolor(14);
Write('DIGER SAYFA ICIN <<ENTER>> TUSUNA BASINIZ...');
Repeat
Kursor(false);
Tus:= Readkey;
Until tus=#13;
prengi(1);
s:=5;
Gotoxy(10,18);Clreol;
end; {if}
end; {if}
end;{for}
Gotoxy(6,s);
Write('ÈÍÍÍÍÍÍÍÍÍÍÍÍÍÊÍÍÍÍÍÍÍÍÍÍÍÍÍÊÍÍÍÍÍÍÍÍÍÍÍÍÍÊ ÍÍÍÍÍÍÍÍÍÍÍÍÍͼ');
Kursor(false);
Textcolor(14);
Gotoxy(30,18); Write('LISTELENECEK KAYITLAR BITTI...');
Textcolor(128+15);
Gotoxy(20,19);
Write('ANA MENUYE DONMEK ICIN <<Esc>> TUSUNA BASINIZ...');
Repeat
Tus:= Readkey;
Until Tus=#27;
Window(1,1,80,25);
Exit;
End;{ana}
(********************* SILME *********************)
Procedure Silme;
Begin
Repeat
Kursor(true);
Textcolor(4) ;
Textbackground(7) ;
Gotoxy(3,23);
Write('URUN KAYIT SILME');
Window(2,3,79,22);
Prengi(1);
kimlik_menu;
Textcolor(15);
ara_SERI1 :=' ';
Get_string (ara_seri1,6,40,0,10) ;ara_seri1 :=ara_seri1 ;
For i:=0 to filesize(dosya)-1 do
Begin
Seek (dosya,i);
Read (dosya,kayit);
If (kayit.d='*') and (kayit.seri=ara_seri1)
then
begin
Prengi(1);
Kimlik_menu;
Kayit_yaz;
Textcolor(14);
Gotoxy(23,19); Write('SILINECEK KAYIT BU MU?');
Evethayir(46,19,51,19);
Repeat
Kursor(false);
Cevap:= Upcase(Readkey);
Until Cevap in ['E','H'];
If Cevap='E' then
begin
Clreol;
kayit.d:='s';
Seek (dosya,i);
Write (dosya,kayit);
Repeat
Textcolor(14);
Gotoxy(28,18); Writeln('SILME ISLEMI TAMAMLANDI...');
Textcolor(128+15);
Textcolor(128+15);
Gotoxy(20,19);
Write('ANA MENUYE DONMEK ICIN <<Esc>> TUSUNA BASINIZ...');
Tus:=readkey;
Until Tus=#27;
Window(1,1,80,25);
Exit ;
end;
end;
end;{for}
Prengi(1);
Textcolor(10);
Cerceve(20,10,60,14);
Gotoxy(22,12);
Write('BOYLE BIR KAYIT DOSYADA MEVCUT DEGIL!');
Textcolor(14);
Gotoxy(15,19);
Write('SILME ISLEMINI TEKRAR DENEYECEK MISINIZ?');
Evethayir(56,19,61,19);
Repeat
Kursor(false);
Devam:= Upcase(Readkey);
Until Devam in ['E','H'];
Until Devam in ['H'];
Textcolor(128+15);
Gotoxy(12,19);clreol;
Gotoxy(17,19);
Write('ANA MENUYE DONMEK ICIN <<Esc>> TUSUNA BASINIZ...');
Repeat
Kursor(false);
Tus:= Readkey;
Until tus=#27;
Window(1,1,80,25);
Exit;
End;{ana}
(************** MENU CERCEVE CIZIMI *************)
Procedure Cer_ciz(renk:integer);
Begin
For i:=2 to 79 do begin
For j:=3 to 22 do begin
Textcolor(1);
Gotoxy(i,j);Write(chr(219));
end;
end;
For i:=30 to 50 do begin
For j:=8 to 17 do begin
Textcolor(0);
Gotoxy(i+2,j+1);Write(chr(219));
Textbackground(renk);Gotoxy(i,j);Write(' ');
end;
end;
Textcolor(14);
For i:=31 to 49 do
begin
Gotoxy(i,8);Write(chr(205));
Gotoxy(i,17);Write(chr(205));
end;
For j:=8 to 17 do
begin
Gotoxy(31,j);Write(chr(186));
Gotoxy(49,j);Write(chr(186));
end;
Gotoxy(31,8) ; Write(chr(201));
Gotoxy(49,8) ; Write(chr(187));
Gotoxy(31,17) ; Write(chr(200));
Gotoxy(49,17) ; Write(chr(188));
End;
(**************** MENU YAZIMI *******************)
Procedure Menu_yaz(k:integer);
Begin
Textcolor(k);
Textbackground(5);
Gotoxy(37,9) ;Write('ANAMENU');
Gotoxy(33,11);Write('KAYIT GIRISI');
Gotoxy(33,12);Write('KAYIT LISTELEME');
Gotoxy(33,13);Write('KAYIT SILME');
Gotoxy(33,14);Write('KAYIT DUZELTME');
Gotoxy(33,15);Write('KAYIT ARAMA');
Gotoxy(33,16);Write('CIKIS [ESC]');
End;
(**************** MENU SECIMI *******************)
Procedure Menu_sec(var s:integer;r:integer);
Begin
Textcolor(r);
Case s of
11:begin Gotoxy(33,11); Write('KAYIT GIRISI') ;end;
11:begin gotoxy(46,11); write('deneme'); end;
12:begin Gotoxy(33,12); Write('KAYIT LISTELEME') ;end;
13:begin Gotoxy(33,13); Write('KAYIT SILME') ;end;
14:begin Gotoxy(33,14); Write('KAYIT DUZELTME') ;end;
15:begin Gotoxy(33,15); Write('KAYIT ARAMA') ;end;
16:begin Gotoxy(33,16); Write('CIKIS [ESC]') ;end;
end;
End;
(***************** MENU KONTROL *****************)
Procedure Menu_kontrol;
Var
sec : char ;
kar,y,i: integer ;
Begin
Cer_ciz(5) ;
Kursor(false);
Menu_yaz(14) ;
y:=11 ;
Textbackground(1);
Gotoxy(32,y);Write(' ':16);
Menu_sec(y,11);
Repeat
sec :=readkey ;
kar :=ord(sec);
Case kar of
64:begin
Textbackground(5) ;
Gotoxy(65,y);Write(' ':16) ;
Menu_sec(y,11) ;
y:=y+1;
if y<11 then y:=47;
Textbackground(1);
Gotoxy(32,y);Write(' ':16);
Menu_sec(y,11);
end;
72:begin
Textbackground(5) ;
Gotoxy(32,y);Write(' ':16) ;
Menu_sec(y,14) ;
y:=y-1;
if y<11 then y:=16;
Textbackground(1);
Gotoxy(32,y);Write(' ':16);
Menu_sec(y,11);
end;
80:begin
Textbackground(5);
Gotoxy(32,y);Write(' ':16);
Menu_sec(y,14);
y:=y+1;
If y>16 then y:=11;
Textbackground(1);
Gotoxy(32,y);Write(' ':16);
Menu_sec(y,11);
end;
end;
Until (sec=#13) or (sec=#27);
If sec=#27 then y:=16 ;
Case y of
11: begin giris ; end;
12: begin listeleme ; end;
13: begin silme ; end;
14: begin duzeltme ; end;
15: begin arama ; end;
16: begin
zeminrengi(blue);
cikis_menu;
halt(0);
end;
end; {case}
End; {ana}
(************** SA¦ OK TUSU *********************)
procedure sag_ok;
Var
sec : char ;
kar,y,i: integer ;
Begin
Cer_ciz(5) ;
Kursor(false);
Menu_yaz(14) ;
y:=11 ;
Textbackground(1);
Gotoxy(32,y);Write(' ':16);
Menu_sec(y,11);
Repeat
sec :=readkey ;
kar :=ord(sec);
Case kar of
64:begin
Textbackground(4) ;
Gotoxy(75,y);Write(' ':16) ;
Menu_sec(y,11) ;
y:=y+1;
if y<11 then y:=47;
Textbackground(1);
Gotoxy(32,y);Write(' ':16);
Menu_sec(y,11);
end;
64:begin
Textbackground(5) ;
Gotoxy(65,y);Write(' ':16) ;
Menu_sec(y,11) ;
y:=y+1;
if y<11 then y:=47;
Textbackground(1);
Gotoxy(32,y);Write(' ':16);
Menu_sec(y,11);
end;
72:begin
Textbackground(5) ;
Gotoxy(32,y);Write(' ':16) ;
Menu_sec(y,14) ;
y:=y-1;
if y<11 then y:=16;
Textbackground(1);
Gotoxy(32,y);Write(' ':16);
Menu_sec(y,11);
end;
80:begin
Textbackground(5);
Gotoxy(32,y);Write(' ':16);
Menu_sec(y,14);
y:=y+1;
If y>16 then y:=11;
Textbackground(1);
Gotoxy(32,y);Write(' ':16);
Menu_sec(y,11);
end;
end;
Until (sec=#13) or (sec=#27);
If sec=#27 then y:=16 ;
Case y of
11: begin giris ; end;
12: begin listeleme ; end;
13: begin silme ; end;
14: begin duzeltme ; end;
15: begin arama ; end;
16: begin
zeminrengi(blue);
cikis_menu;
halt(0);
end;
end; {case}
End; {ana}
(***************** ANA PROGRAM *****************)
BEGIN
Assign(Dosya,'C:\Kimlik.dat');
{$I-}
Reset(dosya);
{$I+}
If ioresult <> 0 then Rewrite(dosya);
Repeat
Clrscr;
Zeminrengi(0);
Ana_cerceve;
Menu_kontrol;
Until false;
Close(dosya);
END.
|
Normal
