Geri git   Van.GEN.TR Forum | Yerel Van Forumu > Bilgisayar > Programlama > Pascal
Sayfaya güncelle depo kayýt(stok) programý

Cevapla
 
Konu Araçlarý Stil
Alt 24/04/07, 00:58   #1
gokhanaygun
Tuðgeneral
 
gokhanaygun - ait Kullanıcı Resmi (Avatar)
 
Üyelik tarihi: Apr 2007
Bulunduðu yer: VAN
Yaş: 36
Mesajlar: 924
Tecrübe Puanı: 26 gokhanaygun is a splendid one to behold gokhanaygun is a splendid one to behold gokhanaygun is a splendid one to behold gokhanaygun is a splendid one to behold gokhanaygun is a splendid one to behold gokhanaygun is a splendid one to behold gokhanaygun is a splendid one to behold
Standart 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.
gokhanaygun isimli Üye şimdilik offline konumundadır   Alıntı ile Cevapla
Konu Sayýsý: 187
Alt 20/06/08, 15:22   #2
firari
Mareþal
 
firari - ait Kullanıcı Resmi (Avatar)
 
Üyelik tarihi: Sep 2007
Mesajlar: 5.835
Tecrübe Puanı: 104 firari has a reputation beyond repute firari has a reputation beyond repute firari has a reputation beyond repute firari has a reputation beyond repute firari has a reputation beyond repute firari has a reputation beyond repute firari has a reputation beyond repute firari has a reputation beyond repute firari has a reputation beyond repute firari has a reputation beyond repute firari has a reputation beyond repute
Standart
Paylaşım için tşkler…
__________________
firari isimli Üye şimdilik offline konumundadır   Alıntı ile Cevapla
Konu Sayýsý: 613
Takýmýnýz:
Alt 30/06/08, 01:55   #3
Mattet
Cumhurbaþkaný
 
Mattet - ait Kullanıcı Resmi (Avatar)
 
Üyelik tarihi: May 2008
Bulunduðu yer: van
Mesajlar: 7.027
Tecrübe Puanı: 48 Mattet has a reputation beyond repute Mattet has a reputation beyond repute Mattet has a reputation beyond repute Mattet has a reputation beyond repute Mattet has a reputation beyond repute Mattet has a reputation beyond repute Mattet has a reputation beyond repute Mattet has a reputation beyond repute Mattet has a reputation beyond repute Mattet has a reputation beyond repute Mattet has a reputation beyond repute
Standart
teŞekkÜrler PaylaŞim İİÇİn
__________________





Düþmeden Bulutlarda Koþmam GereK !
Mattet isimli Üye şimdilik offline konumundadır   Alıntı ile Cevapla
Konu Sayýsý: 866
Alt 31/07/08, 15:40   #4
Neutralizer
Yasaklý kullanýcý
 
Neutralizer - ait Kullanıcı Resmi (Avatar)
 
Üyelik tarihi: Jan 2008
Bulunduðu yer: Ýstediðin yerden
Mesajlar: 1.883
Tecrübe Puanı: 0 Neutralizer has a reputation beyond repute Neutralizer has a reputation beyond repute Neutralizer has a reputation beyond repute Neutralizer has a reputation beyond repute Neutralizer has a reputation beyond repute Neutralizer has a reputation beyond repute Neutralizer has a reputation beyond repute Neutralizer has a reputation beyond repute Neutralizer has a reputation beyond repute Neutralizer has a reputation beyond repute Neutralizer has a reputation beyond repute
Standart
paylaşım için tşkrlr
Neutralizer isimli Üye şimdilik offline konumundadır   Alıntı ile Cevapla
Konu Sayýsý: 316
Takýmýnýz:
Cevapla

« önceki Konu | sonraki Konu »

Konuyu Toplam 1 Üye okuyor. (0 Kayıtlı üye ve 1 Misafir)
 

Yetkileriniz
Yeni Mesaj yazma yetkiniz Aktif deðil dir.
Mesajlara Cevap verme yetkiniz aktif deðil dir.
Eklenti ekleme yetkiniz Aktif deðil dir.
Kendi Mesajýnýzý deðiþtirme yetkiniz Aktif deðildir dir.
BB code is Açık
Smileler Açık
[IMG] Kodları Açık
HTML-KodlarıKapalı
Gitmek istediğiniz klasörü seçiniz


Bütün Zaman Ayarları WEZ +3 olarak düzenlenmiştir. Şu Anki Saat: 16:02 .

Van.GEN.TR Forum | Yerel Van Forumu - Sitemap - Kullanım sözleşmesi - Yukarı git

Powered by vBulletin
Copyright © 2000-2007 Jelsoft Enterprises Limited.
Sitemap
6, 5, 3, 7, 8, 9, 10, 11, 12, 13, 14, 15, 113, 16, 17, 18, 19, 81, 20, 27, 22, 23, 24, 25, 26, 48, 28, 29, 30, 31, 32, 33, 34, 35, 36, 37, 38, 39, 43, 136, 40, 58, 45, 42, 44, 46, 47, 53, 54, 55, 56, 57, 59, 60, 70, 61, 62, 63, 64, 65, 66, 68, 69, 71, 72, 74, 75, 76, 77, 78, 79, 80, 82, 83, 96, 84, 85, 86, 87, 88, 89, 90, 91, 92, 93, 94, 95, 98, 97, 100, 101, 102, 103, 106, 104, 105, 112, 109, 108, 107, 110, 111, 114, 115, 118, 116, 117, 119, 148, 154, 124, 165, 122, 120, 123, 121, 150, 153, 125, 128, 129, 131, 132, 133, 134, 135, 137, 138, 139, 140, 141, 142, 143, 144, 145, 146, 147, 151, 149, 202, 175, 164, 152, 167, 155, 156, 157, 158, 159, 160, 161, 162, 163, 195, 169, 166, 168, 170, 171, 172, 199, 174, 173, 196, 200, 176, 177, 180, 178, 179, 182, 189, 187, 184, 186, 191, 192, 193, 194, 197, 198, 201, 203, 229, 204, 205, 206, 207, 208, 209, 210, 211, 212, 213, 214, 215, 216, 217, 218, 219, 220, 221, 222, 223, 224, 236, 231, 232, 233, 234, 235, 237, 240, 239, 241, 243, 242, 244,