Programalama > PASCAL

uses crt;
type
kayit=record
isim:string;
soyad:string;
sinif:string;
no:string;
y1,y2,y3:integer;
evno:longint;
f:char;
end;
var
dosya:file of kayit;
kay:kayit;
tus,t:char;
i,kod:integer;
Procedure kayityap;
begin
assign(dosya,'ogr.dat');
{$i-} Reset (dosya);kod:=ioresult;{$i+}
if kod<>0 then rewrite(dosya);
repeat
clrscr;
gotoxy(15,5); write('Hastann;');
gotoxy(15,7); write('Adi Girin...'); Readln(kay.isim);
if kay.isim='' then
begin
close(dosya);exit;end;
gotoxy(15,9);write('Soyadi Girin...');readln(kay.soyad);
gotoxy(15,11);write('Gelis Nedeni Girin...'); readln(kay.sinif);
gotoxy(15,13);write('Hangi B&#8221;lme G&#8221;nderildi Girin... ');readln(kay.no);
gotoxy(15,15);write('Teshis Girin...');readln(kay.evno);
gotoxy(15,17);write('Yatirilacak Mi? [e/h]');readln(kay.y1);
gotoxy(15,19);write('Kat No Girin ');readln(kay.y2);
gotoxy(15,21);write('Oda No Girin');readln(kay.y3);
gotoxy(16,23);write('Bilgiler Dosyaya yazilsin mi?  [E / H ]');
repeat
tus:=upcase(readkey);
until tus in ['E','H'];
if tus='E' then
begin
kay.f:='*';
seek(dosya,filesize(dosya));
write(dosya,kay);
end;
until 1=2;
end;
Procedure listeleme;
var
s:integer;
begin
assign(dosya,'ogr.dat');
{$i-} reset (dosya); i:=ioresult; {$i+}
if i<>0 then
begin
gotoxy(33,40); writeln('... Kayit yok ...');
tus:=readkey; halt;
end;
clrscr;
gotoxy(3,3);
writeln('                            KAYITLI HASTALARIN LISTESI');
writeln('                           ****************************');
s:=0;
for i:=0 to filesize(dosya)-1 do
begin
seek(dosya,i); read(dosya,kay);
if kay.f='*' then
begin
s:=s+7;
writeln;
writeln('* Adi          :',kay.isim);
writeln('* Soyadi       :',kay.soyad);
writeln('* Sinifi       :',kay.sinif);
writeln('* Numarasi     :',kay.no);
end;
if s>18 then
begin
gotoxy(25,60);
write('... Diger kayitlar i&#8225;in bir tusa bas ...');
tus:=readkey;
s:=0;
clrscr;
end;
end;
gotoxy(25,40);
write('... Listelenecek Kayitlar Bitti ...');
tus:=readkey;
close(dosya);
end;
procedure arama;
var
ara:string;
begin
assign(dosya,'ogr.dat');
{$i-} reset(dosya); kod:=ioresult; {$i+}
if kod<>0 then
begin
gotoxy(33,40); writeln('... kayit yok ...');
tus:=readkey; exit;
end;
repeat
clrscr;
gotoxy(22,4); write('Aradiginiz isim...:'); readln(ara);
if ara='' then
begin
close(dosya); exit;
end;
for i:=0 to filesize(dosya)-1 do
begin
seek(dosya,i); read(dosya,kay);
if (kay.f='*') and (kay.isim=ara) then
begin
clrscr;
gotoxy(15,7); write('Adi...:',kay.isim);
gotoxy(15,9); write('Soyadi...:',kay.soyad);
gotoxy(15,11); write('Sinifi...:',kay.sinif);
gotoxy(15,13); write('Numarasi...:',kay.no);
gotoxy(15,15); write('Ev Numarasi...:',kay.evno);
gotoxy(15,17); write('1.Yazili...:',kay.y1);
gotoxy(15,19); write('2.Yazili...:',kay.y2);
gotoxy(15,21); write('3.Yazili...:',kay.y3);
gotoxy(25,23); write('Aradiginiz Kayit Bu Mu? [E/H]...:');
repeat
tus:=upcase(readkey);
until tus in ['E','H'];
if tus='E' then
begin
close(dosya); exit;
end;
end;
end;
writeln;
gotoxy(15,25);
write('Aradiginiz Kayit Yok. Devam etmek i&#8225;in bir tusa bas');
tus:=readkey;
until 1=2;
end;
procedure duzeltme;
var
ara:string;
begin
assign(dosya,'ogr.dat');
{$i-} reset (dosya); kod:=ioresult; {$i+}
if kod<>0 then
begin
gotoxy(33,40); write('... Kayit yok ...');
tus:=readkey; exit;
end;
clrscr;
gotoxy(15,4); write('Dzeltilecek isim...:'); readln(ara);
if ara='' then
begin
close(dosya); exit;
end;
for i:=0 to filesize(dosya)-1 do
begin
seek(dosya,i); read(dosya,kay);
if (ara=kay.isim) and (kay.f='*') then
begin
clrscr;
gotoxy(15,7); write('Adi...:',kay.isim);
gotoxy(15,9); write('Soyadi...:',kay.soyad);
gotoxy(15,11); write('Sinifi...:',kay.sinif);
gotoxy(15,13); write('Numarasi...:',kay.no);
gotoxy(15,15); write('Ev Numarasi...:',kay.evno);
gotoxy(15,17); write('1.Yazili...:',kay.y1);
gotoxy(15,19); write('2.Yazili...:',kay.y2);
gotoxy(15,21); write('3.Yazili...:',kay.y3);
gotoxy(20,23); write('Dzeltilecek Kayit Bu Mu? [E/H]...:');
repeat
tus:=upcase(readkey);
until tus in ['E','H'];
if tus='E' then
repeat
clrscr;
gotoxy(15,7); write('1) Adi...:',kay.isim);
gotoxy(15,9); write('2) Soyadi...:',kay.soyad);
gotoxy(15,11); write('3) Sinifi...:',kay.sinif);
gotoxy(15,13); write('4) Numarasi...:',kay.no);
gotoxy(15,15); write('5) Ev Numarasi...:',kay.evno);
gotoxy(15,17); write('6) 1.Yazili...:',kay.y1);
gotoxy(15,19); write('7) 2.Yazili...:',kay.y2);
gotoxy(15,21); write('8) 3.Yazili...:',kay.y3);
gotoxy(15,23); write('9) Islem Sonu');
gotoxy(20,25); write('Se&#8225;iminiz (1 . . 9) ...:');
repeat
tus:=readkey;
until tus in ['1'..'9'];
case tus of
'1':begin
gotoxy(15,30);
write('Adi...:'); readln(kay.isim);
end;
'2':begin
gotoxy(15,30);
write('Soyadi...:'); readln(kay.soyad);
end;
'3':begin
gotoxy(15,30);
write('Sinifi...:'); readln(kay.sinif);
end;
'4':begin
gotoxy(15,30);
write('Numarasi...:'); readln(kay.no);
end;
'5':begin
gotoxy(15,30);
write('Ev Numarasi...:'); readln(kay.evno);
end;
'6':begin
gotoxy(15,30);
write('1.Yazili...:'); readln(kay.y1);
end;
'7':begin
gotoxy(15,30);
write('2.Yazili...:'); readln(kay.y2);
end;
'8':begin
gotoxy(15,30);
write('3.Yazili...:'); readln(kay.y3);
end;
'9':begin
seek(dosya,i);
write(dosya,kay);
gotoxy(30,28); write('... Islem Tamamlandi ...');
close (dosya);
tus:=readkey; exit;
end;
#27:exit;
end;
until 1=2;
end;
end;
gotoxy(33,40); write('... Kayit Yok ...');
close(dosya);
tus:=readkey;
end;
procedure silme;
var
ara:string;
begin
assign(dosya,'ogr.dat');
{$i-} reset(dosya); kod:=ioresult; {$i+}
if kod<>0 then
begin
gotoxy(33,40); writeln('... kayit yok ...');
tus:=readkey;
exit;
end;
clrscr;
gotoxy(15,4); write('Silinecek isim...:'); readln(ara);
if ara='' then
begin
close(dosya); exit;
end;
for i:=0 to filesize(dosya)-1 do
begin
seek(dosya,i);
read(dosya,kay);
if (ara=kay.isim) and (kay.f='*') then
begin
clrscr;
gotoxy(15,7); write('Adi...:',kay.isim);
gotoxy(15,9); write('Soyadi...:',kay.soyad);
gotoxy(15,11); write('Sinifi...:',kay.sinif);
gotoxy(15,13); write('Numarasi...:',kay.no);
gotoxy(15,15); write('Ev Numarasi...:',kay.evno);
gotoxy(15,17); write('1.Yazili...:',kay.y1);
gotoxy(15,19); write('2.Yazili...:',kay.y2);
gotoxy(15,21); write('3.Yazili...:',kay.y3);
gotoxy(25,23); write('Silinecek Kayit Bu Mu? [E/H]...:');
repeat
tus:=upcase(readkey);
until tus in ['E','H'];
if tus='E' then
begin
kay.f:='s';
seek(dosya,i); write(dosya,kay);
gotoxy(33,40); write('... Kayit Silindi ...');
close(dosya);
tus:=readkey;
exit;
end;
end;
end;
gotoxy(33,40); write('... kayit yok ...');
close(dosya);
tus:=readkey;
end;
procedure menu;
begin
repeat
clrscr;
writeln(''); writeln(''); writeln(''); writeln('');
writeln(''); writeln(''); writeln(''); writeln('');
writeln(''); writeln(''); writeln(''); writeln('');
writeln(''); writeln(''); writeln(''); writeln('');
textcolor(9);
writeln('                              OGRENCI KAYIT PROGRAMI');
writeln('');writeln(''); writeln('');
writeln('              ***************************************************');
writeln('              * *********************************************** *');
writeln('              * *                                             * *');
writeln('              * *               ****** MENU ******            * *');
writeln('              * *              1- KAYIT GIRISI                * *');
writeln('              * *              2- KAYIT LISTELEME             * *');
writeln('              * *              3- KAYIT ARAMA                 * *');
writeln('              * *              4- KAYIT DUZELTME              * *');
writeln('              * *              5- KAYIT SILME                 * *');
writeln('              * *              6- CIKIS=ESC                   * *');
writeln('              * *                                             * *');
writeln('              * *********************************************** *');
writeln('              ***************************************************');
textcolor(2); gotoxy(100,100);
writeln('');
writeln('');
writeln('');
writeln('');
write('                                             Se&#8225;iminiz...:');
textcolor(15); gotoxy(100,100);
repeat
tus:=readkey;
until tus in ['1'..'6',#27];
if tus<>#27 then
case tus of
'1':kayityap;
'2':listeleme;
'3':arama;
'4':duzeltme;
'5':silme;
'6':exit;
end;
until tus=#27;
end;
begin
menu;
end.



erdogan ozcan
erdoganozcan@gmail.com