Pascalda Not takip Programı...

[sherlock_holmes]

Pascalda öğrenci takip programı adı altında bir program oluşturacağız.bana procedure olarak önce "NOT TAKİP PROGRAMI" nı verdiler. programöın nasl yapılacağını kısaca açıklayayım..ya baya ilerlemiştim hoca beğenmedi baştan yaptırdı önce sınıfları girdiriyorum sonra ordan sınıflardan herhangi bir tanesini seçerek örneğn 10-a yı seçtik o zaman bize 10a nın dersleri menü şeklinde gelecek şekile ayarlıyorum. sonra o derslerdende 1 tanesini seç,iyorum ve sınıfın O DERSTEKİ notları ekrana geliyor programın bir bölümü {NOt takip}
uses crt;
const
ders:array[1..10] of string=('At”lye','Fizik','Kimya','Matematik','Edebiyat','Biyoloji',
'ingilizce','Beden','Din','Secmeli ders');

type sin_kayit=record
sinif:string [10];
end;

var
sin_dosya: file of sin_kayit;
sin_dd:sin_kayit;

ad:string[10];
no:string[11];
tush:char;
tush2:char;
sinif:string[5];
sube:string[5];
derss:integer;

function buyult (ch:char):char;
begin
if ch='i' then ch:='˜';
if ch='”' then ch:='™';
if ch='‡' then ch:='€';
if ch='' then ch:='I';
if ch='§' then ch:='¦';
if ch='' then ch:='š';
if ch='Ÿ' then ch:='ž' else ch:=upcase(ch);
buyult:=ch;
end;

function oku (y,x, yazi,zemin,eski_zemin,uzunluk,oku_tip:integer):string;
var
son, okunan:string;
tush:char;
i,adet:integer;

begin

textbackground(zemin);
for i:=0 to uzunluk-1 do begin
gotoxy (y+i,x);write (#32);
end;
textcolor (yazi);
gotoxy (y,x);

for i:=1 to 255 do
okunan:=#32;

adet:=0;

repeat
tush:=buyult(readkey);

if tush=#0 then begin
tush:=readkey;
if tush=#75 then begin {sol ok}
if adet>0 then adet:=adet-1;
gotoxy (y+adet,x);
continue;
end;

if tush=#77 then begin {sol ok}
if adet<uzunluk then adet:=adet+1;
gotoxy (y+adet,x);
continue;
end;

end;

if tush=#8 then {BACKSPACE tuŸuna baslrsa}
if adet>0 then
begin

for i:=adet to uzunluk do
okunan:=okunan[i+1];
okunan[uzunluk]:=#32;
adet:=adet-1;
for i:=1 to uzunluk do begin
gotoxy (y+i-1,x);write (okunan); end;
gotoxy (1,1);write (adet);
gotoxy (y+adet,x);
end;

if oku_tip=1 then
if tush in ['a'..'z','A'..'Z','','˜','”','™','‡','€','','š','§','¦','Ÿ','ž',#32] then
if adet<uzunluk then begin
adet:=adet+1;
okunan[adet]:=tush;
gotoxy (1,1);write (adet);
for i:=1 to uzunluk do begin
gotoxy (y+i-1,x);write (okunan); end;
gotoxy (y+adet,x);
end;

if oku_tip=0 then
if tush in ['0'..'9'] then
if adet<uzunluk then begin
adet:=adet+1;
okunan[adet]:=tush;
gotoxy (1,1);write (adet);
for i:=1 to uzunluk do begin
gotoxy (y+i-1,x);write (okunan); end;
gotoxy (y+adet,x);
end;

if oku_tip=2 then
if tush in ['0'..'9', 'a'..'z','A'..'Z','','˜','”','™','‡','€','','š','§','¦','Ÿ','ž',#32] then
if adet<uzunluk then begin
adet:=adet+1;
okunan[adet]:=tush;
gotoxy (1,1);write (adet);
for i:=1 to uzunluk do begin
gotoxy (y+i-1,x);write (okunan); end;
gotoxy (y+adet,x);
end;

until (tush=#13) or (tush=#9);

textbackground(eski_zemin);
for i:=0 to uzunluk-1 do begin
gotoxy (y+i,x);write (#32);
end;

gotoxy (y,x);write (copy (okunan,1,adet));
{for i:=1 to uzunluk do
son:=okunan;}
oku:=copy (okunan,1,adet);

end;


procedure sinif_kayit;
var i,a,x:integer;
tush:char;
LABEL AA;
begin
clrscr;
assign(sin_dosya,'C:\snf.dat');

{$i-}
reset (sin_dosya);
{$i+}

if ioresult <> 0 then rewrite(sin_dosya);

CLRSCR;
AA:


textcolor(0);
textbackground(15);
clrscr;


gotoxy (3,2);write('Sinifinizi Giriniz..: ');sinif:=oku(25,2,15,1,15,2,0);
gotoxy (3,3);write('Subeyi giriniz......: ');sube:= oku(25,3,15,1,15,2,1);

for i:=0 to filesize (sin_dosya)-1 do begin
seek (sin_dosya,i);read (sin_dosya,sin_dd);
if (sin_dd.sinif = sinif+'/'+sube) then begin
gotoxy (10,10);write ('BU SINIF DAHA ™NCEDEN KAYITLI..YENi iSiM GiRMEK i€iN BiR TU$A BAS..');
gotoxy (10,11);write ('€IKMAK ICIN ESC TUSUNA BASINIZ...');
tush:=readkey;

CLRSCR;

if tush=#27 then begin
close (sin_dosya);
exit;
end else GOTO AA;
end;
end;

sin_dd.sinif:=sinif+'/'+sube;
seek (sin_dosya,filesize(sin_dosya));write (sin_dosya,sin_dd);

close (sin_dosya);

end;

begin
sinif_kayit;
end.
(bunu devam ettirmmiz gerekiyo ancak tipli dosya olacak....)

 

[ALpMontana]

paylasım ıcın tesekkurler.