Pascal / Listeleme ve Dosyalama

Genghis Khan · 20 Haz 2010

Öğrenci not ve bilgilerini kayıt eder.

=========================================================

uses crt;
const
dosyaAdi:string='c:\a.txt';
vizeOrani:integer=40;
finalOrani:integer=60;
gecmeOrani:integer=50;

type
ogrBilgi=record
Numara:integer;
Adi:string;
vize:integer;
final:integer;
ort:integer;
but:integer;
Durum:string;
end;

var
ogrgrBilgi;
dosya:file of ogrBilgi;
ioresult:integer;

function inttostr(int:integer):string;
var
sonuc:string;
begin
str(int,sonuc);
inttostr:=sonuc;
end;

function realtostr(int:real):string;
var
sonuc:string;
begin
str(int,sonuc);
realtostr:=sonuc;
end;

function strtoint(str:string):integer;
var
sonuc:integer;
errorflag:integer;
begin
sonuc:=0;
val(str,sonuc,errorflag);
strtoint:=sonuc;
end;

function strtoreal(str:string):real;
var
sonuc:real;
errorflag:integer;
begin
sonuc:=0;
val(str,sonuc,errorflag);
strtoreal:=sonuc;
end;

procedure kutu(x1,y1,x2,y2,r1,r2:integer);
var
k,h,j:integer;
begin
textcolor(r1);textbackground(r2);
gotoxy(x1,y1);write(#201);
for k:=x1+1 to x2-1 do
begin
gotoxy(k,y1); write(#205);
gotoxy(k,y2); write(#205);
end;
gotoxy(x2,y1); write(#187);
gotoxy(x1,y2); write(#200);
for h:=y1+1 to y2-1 do
begin
gotoxy(x1,h);write(#186);
gotoxy(x2,h);write(#186);
end;
gotoxy(x2,y2);write(#188);
end;

function SayfaSayisi:integer;
begin
sayfasayisi:=0;

{$i-} assign(dosya,dosyaAdi); reset(dosya); {$i+}
if ioresult<>0 then begin writeln('dosya yok');readln; exit; end;
if filesize(dosya) >0 then
begin
if (filesize(dosya)/18 > trunc(filesize(dosya)/18) ) then
sayfaSayisi:= trunc(filesize(dosya)/18)+1
else
sayfaSayisi:= trunc(filesize(dosya)/18);

end;

close(dosya);
end;

procedure yaz(x,y:integer;str:string);
begin
gotoxy(x,y);write(str);
end;

procedure ekranCiz(sayfa:integer;menu:integer;SayfaAdi:string);

const
bosluk:string=' ';
sutun:array [1..8] of byte=(2,8,16,56,61,66,71,76);
sutunBoyut:array [1..8] of byte=(3,7,38,3,3,3,3,3);
satirBaslangic:integer=3;

var
sira,i,xi,yi,x,y:integer;
key:char;
kontrol:boolean;
gecerliSutunlar,str:string;
hucre :array [1..8,1..18] of string[30];

procedure listeOku(sayfa:integer);
var
loSira,sayac:integer;
begin
sayac:=0;
{$i-} assign(dosya,dosyaAdi);reset(dosya); {$i+}
if ioresult<>0 then begin writeln('dosya yok');readln; exit; end;
for losira:=(1) to 18 do
begin
hucre[1,losira]:=";
hucre[2,losira]:=";
hucre[3,losira]:=";
hucre[4,losira]:=";
hucre[5,losira]:=";
hucre[6,losira]:=";
hucre[7,losira]:=";
hucre[8,losira]:=";

end;

for losira:=(18*(sayfa-1))+1 to filesize(dosya)-1 do
begin
if losira<=sayfa*18 then
begin
sayac:=sayac+1;
seek(dosya,losira); read(dosya,ogr);
hucre[2,sayac]:=inttostr(ogr.Numara);
hucre[3,sayac]:=ogr.Adi;
hucre[4,sayac]:=inttostr(ogr.vize);
hucre[5,sayac]:=inttostr(ogr.final);
hucre[6,sayac]:=inttostr(ogr.ort);
hucre[7,sayac]:=inttostr(ogr.but);
hucre[8,sayac]:=ogr.Durum;

end
else
begin
break;
end;
end;
close(dosya);
end;

procedure listeYaz(sayfa:integer);
var
lysira,sayac:integer;
begin
sayac:=0;

{$i-} assign(dosya,dosyaAdi); reset(dosya); {$i+}
if ioresult<>0 then begin writeln('dosya yok');readln; exit; end;
for lysira:=18*(sayfa-1)+1 to 18*(sayfa) do
begin
if (lysira<=sayfa*18) then
begin
sayac:=sayac+1;
ogr.Numara:=strtoint(hucre[2,sayac]);
ogr.Adi:=hucre[3,sayac];
ogr.vize:=strtoint(hucre[4,sayac]);
ogr.final:=strtoint(hucre[5,sayac]);
ogr.ort:=strtoint(hucre[6,sayac]);
ogr.but:=strtoint(hucre[7,sayac]);
ogr.Durum:=hucre[8,sayac];
seek(dosya,lysira); write(dosya,ogr);
end
else
begin
break;
end;
end;
close(dosya);
end;

procedure hesapla;
var
hdon:integer;
hesap:real;
begin
for hdon:=1 to 18 do
begin
hesap:=0;
if (hucre[4,hdon]<>") and (hucre[7,hdon]<>'0') then
begin
hesap:=strtoint(hucre[4,hdon])*(vizeorani/100);
hesap:=hesap+strtoint(hucre[7,hdon])*(finalorani/100);
hucre[6,hdon]:=inttostr(round(hesap));
if round(hesap)>=gecmeOrani then
hucre[8,hdon]:='OK'
else
hucre[8,hdon]:='Kal';

end
else if (hucre[4,hdon]<>") and (hucre[5,hdon]<>'0') then
begin
hesap:=strtoint(hucre[4,hdon])*(vizeorani/100);
hesap:=hesap+strtoint(hucre[5,hdon])*(finalorani/100);
hucre[6,hdon]:=inttostr(round(hesap));
if round(hesap)>=gecmeOrani then
hucre[8,hdon]:='OK'
else
hucre[8,hdon]:='But';

end;
end;

end;

begin
x:=1; y:=1;
listeoku(sayfa);
if menu=1 then gecerliSutunlar:='23';
if menu=2 then gecerliSutunlar:='4';
if menu=3 then gecerliSutunlar:='5';
if menu=4 then gecerliSutunlar:='7';
if menu=5 then gecerliSutunlar:=";
if length(gecerliSutunlar)=1 then
x:= strtoint(gecerliSutunlar);

repeat
clrscr;
for i:=1 to 80 do
begin
gotoxy(i,1);write('*');
gotoxy(i,3);write('*');
gotoxy(i,23);write('*');
end;
for i:=1 to 23 do
begin
gotoxy(1,i);write('*');
gotoxy(6,i);write('*');
gotoxy(15,i);write('*');
gotoxy(55,i);write('*');
gotoxy(60,i);write('*');
gotoxy(65,i);write('*');
gotoxy(70,i);write('*');
gotoxy(75,i);write('*');
end;
gotoxy(2,2);write('Sec');
gotoxy(8,2);write('Ogr No');
gotoxy(26,2);write('Ogr Adi');
gotoxy(56,2);write('Vz');
gotoxy(61,2);write('Fnl');
gotoxy(66,2);write('Ort');
gotoxy(71,2);write('But');
gotoxy(76,2);write('Drm');
gotoxy(1,24);write(sayfa,'/' ,SayfaSayisi,') - < ',SayfaAdi,' > F9 Onceki Sayfa F10 Sonraki Sayfa ');

for yi:=1 to 18 do
for xi:=1 to 8 do
begin
gotoxy(sutun[xi],satirBaslangic+yi);write(hucre[xi,yi]);
end;
gotoxy(sutun[1],y+satirBaslangic);write('XXX');
gotoxy(sutun[x],y+satirBaslangic);
kontrol:=false;
key:=readkey;
if key=#0 then begin key:=readkey; kontrol:=true; end;
if key=#80 then begin y:=y+1; if y>18 then y:=1; end;
if key=#72 then begin y:=y-1; if y<1 then y:=18; end;
if key=#67 then begin listeYaz(sayfa);sayfa:=sayfa-1; if sayfa<0 then sayfa:=1; ekranciz(sayfa,menu,SayfaAdi); exit; end;
if key=#68 then
begin
listeYaz(sayfa);
sayfa:=sayfa+1;
if (sayfa>SayfaSayisi) and (menu>1) then sayfa:=SayfaSayisi; ekranciz(sayfa,menu,SayfaAdi); exit; end;
if key=#77 then begin if (pos(inttostr(x+1),gecerliSutunlar)>0) then begin x:=x+1; if x>8 then x:=1; end; end;
if key=#75 then begin if (pos(inttostr(x-1),gecerliSutunlar)>0) then begin x:=x-1; if x<1 then x:=8; end; end;
if key=#27 then begin listeyaz(sayfa); exit; end;
if key=#13 then
begin
hucre[x,y]:=str; str:=";
if (pos(inttostr(x+1),gecerliSutunlar)>0) then begin x:=x+1; if x>8 then x:=1; end; end;
gotoxy(sutun[x],y+satirBaslangic);
if (not kontrol) and (not(key in [#13,#27])) and (gecerliSutunlar<>") then
begin
if key=#8 then
begin
if length(str)>0 then
str:=copy(str,1,length(str)-1);
end
else
begin
if length(str)<sutunBoyut[x] then
str:=str+key;
end;
hucre[x,y]:=str;
end
else
begin
str:=";
hesapla;
end;

until 1=2;

end;

function menuCiz:integer;
var
secim:integer;
begin
repeat
clrscr;
kutu(1,1,79,24,11,12);
yaz(30,10,'Ogrenci Kaydi icin (1)');
yaz(30,11,'Vize Notu icin (2)');
yaz(30,12,'Final Notu icin (3)');
yaz(30,13,'Butunleme Notu icin (4)');
yaz(30,14,'Durum Listesi icin (5)');
yaz(30,15,'Cikis icin (6)');
readln(secim);
CASE secim OF
1 : begin ekranciz(1,1,'Ogrenci Kaydet'); end;
2 : begin ekranciz(1,2,'Vize Notlari'); end;
3 : begin ekranciz(1,3,'Final Notlari'); end;
4 : begin ekranciz(1,4,'Butunleme Notlari'); end;
5 : begin ekranciz(1,5,'Sonuclar'); end;
6 : begin exit; end;
end;
until 1=2;
end;

begin

clrscr;
menuCiz;

end.

Pascal / Listeleme ve Dosyalama

Genghis Khan

Kıdemli Üye

Sosyal medya sayfalarımız