Listeleme ve Dosyalama

[sampiyonbesiktas1]

HERAKLES Otomatik Avlı kalıcı sunucu. 19 Haziran'da açılıyor. Atius & Wizard güvencesiyle hemen kayıt ol, ön kayıt ödülleri aktif. HEMEN TIKLA!

Öğrenci not ve bilgilerini kaydeder.Bunları delphi adlı programlama işlevi uygulayan programa yazarsanız oyun,dosya vb dosyalar üretebilirsiniz.Yani kendinize ait bir oyununuz olur


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.