program nufus

[aLayıNaiSyaN]

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('U');
delay(150);Gotoxy(4,8);Writeln('R');
delay(50);Gotoxy(5,8);Writeln('U');
delay(150);Gotoxy(6,8);Writeln('N');
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('G');
delay(50);Gotoxy(15,8);Writeln('I');
delay(150);Gotoxy(16,8);Writeln('R');
delay(50);Gotoxy(17,8);Writeln('I');
delay(150);Gotoxy(18,8);Writeln('S');
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('G');
delay(50);Gotoxy(24,8);Writeln('R');
delay(150);Gotoxy(25,8);Writeln('A');
delay(50);Gotoxy(26,8);Writeln('M');
delay(150);Gotoxy(27,8);Writeln('I');

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('1');
DELAY(50);Gotoxy(13,9);Writeln('.');
DELAY(150);Gotoxy(14,9);Writeln('0');
Gotoxy(3,10);Writeln('COPYRIGTH MUHTEREM PISIL');
Textcolor(red);

Gotoxy(13,21); Writeln('NIGDE TEKNIK LISE ve ANADOLU MESLEK LISESI BILGISAYAR BOLUMU..');
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(7);
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(1);
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...');