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 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);
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;
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;
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}
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}
Procedure Duzeltme_menusu;
Begin
Assign(Dosya,'C:\Kimlik.dat');
{$I-}
Reset(dosya);
{$I+}
If ioresult <> 0 then Rewrite(dosya);
Textcolor(YELLOW);
Textbackground(1);
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'];
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}
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);
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 *******************)
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
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.