Pascal - Plik Rekordowy I Procedury

[Leszkon]

A wiec tak :) pisze prace dyplomowa (tak z pascala bo najlatwiej :wink: ) i utknalem... :mur:

programik ma klasyfikowac uczniow, czyli po 5 ocenek na 5 przedmiotow na ucznia

NA POCZATKU MIALEM PO 1 OCENIE DO JEDNEGO PRZEDMIOTU (jako string) i caly program smigal teraz go rozbudowuje na 5 ocen i za cho..re niewiem juz co zrobic

 

dopisana procedura "procedure pytanie_pom;"

 

 

pol,ang,mat,fiz,his wczesniej bylo typem lan

program prac_dypl;uses crt;{--------------------------------TYPY WLASNE---------------------------------}type lan=string[20];	 klasyf=record			 nr:lan;			 nazw:lan;			 imie:lan;			 przedm:record					 pol,ang,mat,fiz,his:record										  w:array[1..5] of byte;										  sr:real;										 end;					end;			end;{----------------------------------ZMIENNE-----------------------------------}var dane:klasyf;	plik:file of klasyf;	nazwa1:lan;	dec:char;	j:byte;

dopisana procedura - nie wiem jak zapisac wartosci wektora "w" i liczby "sr" tak aby ta procedure wykozystac w nastepnej (do kazdego przedmiotu)

{----------------------------PROCEDURA POMOCNICZA----------------------------}procedure pytanie_pom;var su,i,x:byte;begin  repeat   writeln('Wszystkie -		   0');   writeln('Pierwsza -			1');   writeln('Druga -			   2');   writeln('Trzecia -			 3');   writeln('Czwarta -			 4');   writeln('Piata -			   5');   writeln('Powrot do menu -	<esc>');   writeln;   dec:=readkey;  until dec in ['0','1','2','3','4','5',#27];  case dec of   '0': begin		 for i:=1 to 5 do		  begin		   write(i,'-a ocena = ');		   readln(w[i]);		  end;		end;   '1': begin		 write('1-a ocena = ');		 readln(w[1]);		end;   '2': begin		 write('2-a ocena = ');		 readln(w[2]);		end;   '3': begin		 write('3-a ocena = ');		 readln(w[3]);		end;   '4': begin		 write('4-a ocena = ');		 readln(w[4]);		end;   '5': begin		 write('5-a ocena = ');		 readln(w[5]);		end;   #27: exit;  end;  sr:=0;  su:=0;  i:=0;  x:=5;  for i:=1 to 5 do		 begin		  su:=su+w[i];		  if w[i]=0 then x:=x-1;		 end;  if x=0 then sr:=0		 else sr:=su/x;  readln(sr);end.

procedurka do zapisywania rekordow (a wlasciwie kolejna podprocedura) w ktorej chce wykozystac ta poprzednia procedurke

{----------------------------PROCEDURA POMOCNICZA----------------------------}procedure pytanie;begin with dane do  begin   writeln;   writeln('POZYCJA: ',filepos(plik)+1);   write('Podaj nr ucznia: ');   readln(nr);	   for j:=1 to length(nr) do	   nr[j]:=upcase(nr[j]);   write('Podaj nazwisko ucznia: ');   readln(nazw);	   for j:=1 to length(nazw) do	   nazw[j]:=upcase(nazw[j]);   write('Podaj imie ucznia: ');   readln(imie);	   for j:=1 to length(imie) do	   imie[j]:=upcase(imie[j]);   write('Podaj oceny z jezyka polskiego: ');   pytanie_pom;   readln(przedm.pol);

i dalsza czesc tej procedurki tylko ze starym zapisem (jak jeszcze mialem po jednej ocenie)

write('Podaj oceny z jezyka angielskiego: ');   readln(przedm.ang);	   for j:=1 to length(przedm.ang) do	   przedm.ang[j]:=upcase(przedm.ang[j]);   write('Podaj oceny z matematyki: ');   readln(przedm.mat);	   for j:=1 to length(przedm.mat) do	   przedm.mat[j]:=upcase(przedm.mat[j]);   write('Podaj oceny z fizyki: ');   readln(przedm.fiz);	   for j:=1 to length(przedm.fiz) do	   przedm.fiz[j]:=upcase(przedm.fiz[j]);   write('Podaj oceny z historii: ');   readln(przedm.his);	   for j:=1 to length(przedm.his) do	   przedm.his[j]:=upcase(przedm.his[j]);  end;  write(plik,dane);  repeat   clrscr;   writeln('Kontynuowac? (T/N)');   dec:=readkey;   dec:=upcase(dec);  until (dec='T') or (dec='N');end;

 

kombinowalem z procedure pytanie_pom(var w:array[1..5] of byte; var sr:real); ale i tak sypalo :mur: a jak dam " with dane.przedmiot.pol do" w poprzedniej to znowu bede musial ja za kazdym razem powtazac :mur:

odpowiedz zapewne jest banalna ale no niepotrafie juz nic wymyslic :mur: help :blink:

Edytowane 10 Maja 2006 przez Leszkon

[Leszkon]

Hehe no i pogadalem z profesorkiem i stwierdzil, ze nie musze tak kombinowac jak kon pod gore i moge napisac taka procedurke dla kazdego przedmiotu - wprawdzie bedzie troszke wiecej miejsca zajmowac ale nie bede mial z tym takich problemow... tak tez zrobilem :D oto efekt:

{----------------------------PROCEDURA POMOCNICZA----------------------------}procedure pytanie_pom_pol;var su,i,x:byte;begin  repeat   writeln('Wszystkie -		   0');   writeln('Pierwsza -			1');   writeln('Druga -			   2');   writeln('Trzecia -			 3');   writeln('Czwarta -			 4');   writeln('Piata -			   5');   writeln('Powrot do menu -	<esc>');   writeln;   dec:=readkey;  until dec in ['0','1','2','3','4','5',#27];  case dec of   '0': begin		 for i:=1 to 5 do		  begin		   write(i,'-a ocena = ');		   readln(dane.przedm.pol.w[i]);		  end;		end;   '1': begin		 write('1-a ocena = ');		 readln(dane.przedm.pol.w[1]);		end;   '2': begin		 write('2-a ocena = ');		 readln(dane.przedm.pol.w[2]);		end;   '3': begin		 write('3-a ocena = ');		 readln(dane.przedm.pol.w[3]);		end;   '4': begin		 write('4-a ocena = ');		 readln(dane.przedm.pol.w[4]);		end;   '5': begin		 write('5-a ocena = ');		 readln(dane.przedm.pol.w[5]);		end;   #27: exit;  end;  dane.przedm.pol.sr:=0;  su:=0;  i:=0;  x:=5;  for i:=1 to 5 do		 begin		  su:=su+dane.przedm.pol.w[i];		  if dane.przedm.pol.w[i]=0 then x:=x-1;		 end;  if x=0 then dane.przedm.pol.sr:=0		 else dane.przedm.pol.sr:=su/x;  write(dane.przedm.pol.sr);end;

oczywiscie analogicznie dla kazdego przedmiotu

 

i wywolanie

{----------------------------PROCEDURA POMOCNICZA----------------------------}procedure pytanie;begin with dane do  begin   writeln;   writeln('POZYCJA: ',filepos(plik)+1);   write('Podaj nr ucznia: ');   readln(nr);	   for j:=1 to length(nr) do	   nr[j]:=upcase(nr[j]);   write('Podaj nazwisko ucznia: ');   readln(nazw);	   for j:=1 to length(nazw) do	   nazw[j]:=upcase(nazw[j]);   write('Podaj imie ucznia: ');   readln(imie);	   for j:=1 to length(imie) do	   imie[j]:=upcase(imie[j]);   write('Podaj oceny z jezyka polskiego: ');   pytanie_pom_pol;   write('Podaj oceny z jezyka angielskiego: ');   pytanie_pom_ang;   write('Podaj oceny z matematyki: ');   pytanie_pom_mat;   write('Podaj oceny z fizyki: ');   pytanie_pom_fiz;   write('Podaj oceny z historii: ');   pytanie_pom_his;  end;  write(plik,dane);  repeat   clrscr;   writeln('Kontynuowac? (T/N)');   dec:=readkey;   dec:=upcase(dec);  until (dec='T') or (dec='N');end;

jak bede jeszcze mial jakies problemy to napisze choc raczej juz powinienem sobie poradzic...

szkoda tylko ze nikt sie nie wysilil aby mi cos doradzic :-P

[PelzaK]

bo tak niezbyt precyzyjnie określiłeś cel zadania... :)

[Leszkon]

No to mam nowy problem i postaram sie precyzyjniej okreslic o co mi chodzi ;)

A wiec tak:w pewnym momencie przy testach zauwazylem ze jak wpisuje nowego ucznia i przychodzi do ocen to jak nie podam zadnej lub podam tylko kilka zostaja przypisane oceny poprzedniego ucznia (na miejsce tych nie wpisanych) :angry: procedury zastosowalem na to osobne i myslalem ze bedzie wszystko cacy a tu D..A :mur:

Pomyslalem sobie ze trzeba jakos zerowac oceny przed wpisaniem lub anulowaniem tylko nie wiem jeszcze jak (moze petla for _ to _ do ) i w ktory miejscu aby mi sie nie kasowaly poprzednie oceny tym bardziej ze chce te same procedury wykorzystac przy korekcie

Zaznaczam jeszcze ze po wprowadzeniu ocen program oblicza srednia (z pominieciem zer) i zapisuje do rekordu (ale nie wyswietla od razu tylko przy odczycie) <-> to dziala nalezycie ;)

POCZATEK i ZAPIS

program prac_dypl;uses crt;{--------------------------------TYPY WLASNE---------------------------------}type lan=string[20];	 klasyf=record			 nr:lan;			 nazw:lan;			 imie:lan;			 przedm:record					 pol,ang,mat,fiz,his:record										  w:array[1..5] of byte;										  sr:real;										 end;					end;			end;{----------------------------------ZMIENNE-----------------------------------}var dane:klasyf;	plik:file of klasyf;	nazwa1:lan;	dec:char;	j:byte;{----------------------------FUNKCJA SPRAWDZAJACA----------------------------}function jest_plik(nazwa:lan):boolean;begin{$I-} assign(plik,nazwa); reset(plik);{$I+} if IOResult=0 then  begin   close(plik);   jest_plik:=true;  end else  jest_plik:=false;end;{----------------------------PROCEDURA POMOCNICZA----------------------------}procedure pytanie_dec(v:lan);begin repeat  writeln;  writeln(v);  writeln('Ktora ocene chcesz wprowadzic?');  writeln('	 Wszystkie -		0');  writeln('	 Pierwsza -		 1');  writeln('	 Druga -			2');  writeln('	 Trzecia -		  3');  writeln('	 Czwarta -		  4');  writeln('	 Piata -			5');  writeln('	 Powrot -		 <esc>');  dec:=readkey; until dec in ['0','1','2','3','4','5',#27];end;{----------------------------PROCEDURA POMOCNICZA----------------------------}procedure pytanie_pom_pol;var su,i,x:byte;begin pytanie_dec('		   J.POLSKI');  case dec of  '0': begin		writeln;		for i:=1 to 5 do		 begin		  repeat		   write(i,'-a ocena (od 1 do 6) = ');		   readln(dane.przedm.pol.w[i]);		  until (dane.przedm.pol.w[i]>=0) and (dane.przedm.pol.w[i]<=6);		 end;	   end;  '1': begin		writeln;		repeat		 write('1-a ocena (od 1 do 6) = ');		 readln(dane.przedm.pol.w[1]);		until (dane.przedm.pol.w[1]>=0) and (dane.przedm.pol.w[1]<=6);	   end;  '2': begin		writeln;		repeat		 write('2-a ocena (od 1 do 6) = ');		 readln(dane.przedm.pol.w[2]);		until (dane.przedm.pol.w[2]>=0) and (dane.przedm.pol.w[2]<=6);	   end;  '3': begin		writeln;		repeat		 write('3-a ocena (od 1 do 6) = ');		 readln(dane.przedm.pol.w[3]);		until (dane.przedm.pol.w[3]>=0) and (dane.przedm.pol.w[3]<=6);	   end;  '4': begin		writeln;		repeat		 write('4-a ocena (od 1 do 6) = ');		 readln(dane.przedm.pol.w[4]);		until (dane.przedm.pol.w[4]>=0) and (dane.przedm.pol.w[4]<=6);	   end;  '5': begin		writeln;		repeat		 write('5-a ocena (od 1 do 6) = ');		 readln(dane.przedm.pol.w[5]);		until (dane.przedm.pol.w[5]>=0) and (dane.przedm.pol.w[5]<=6);	   end;  #27: exit;  end;  dane.przedm.pol.sr:=0;  su:=0;  i:=0;  x:=5;  for i:=1 to 5 do		 begin		  su:=su+dane.przedm.pol.w[i];		  if dane.przedm.pol.w[i]=0 then x:=x-1;		 end;  if x=0 then dane.przedm.pol.sr:=0		 else dane.przedm.pol.sr:=su/x;end;.............I TAK ANALOGICZNIE PROCEDURY DO J.ANGIELSKIEGO, MATEMATYKI, FIZYKI I HISTORI.............{----------------------------PROCEDURA POMOCNICZA----------------------------}procedure oceny(v:lan);var dec2:char;begin repeat  repeat   writeln;   writeln('	 Wybierz przedmiot:');   writeln('	 J.polski -		1');   writeln('	 J.angielski -	 2');   writeln('	 Matematyka -	  3');   writeln('	 Fizyka -		  4');   writeln('	 Historia -		5');   writeln('	 ',v,'		 <esc>');   dec2:=readkey;  until dec2 in ['1','2','3','4','5',#27];  case dec2 of  '1': pytanie_pom_pol;  '2': pytanie_pom_ang;  '3': pytanie_pom_mat;  '4': pytanie_pom_fiz;  '5': pytanie_pom_his;  #27: exit;  end; until dec2=#27;end;{----------------------------PROCEDURA POMOCNICZA----------------------------}procedure pytanie;begin with dane do  begin   clrscr;   writeln('POZYCJA: ',filepos(plik)+1);   write('Podaj nr ucznia: ');   readln(nr);	   for j:=1 to length(nr) do	   nr[j]:=upcase(nr[j]);   write('Podaj nazwisko ucznia: ');   readln(nazw);	   for j:=1 to length(nazw) do	   nazw[j]:=upcase(nazw[j]);   write('Podaj imie ucznia: ');   readln(imie);	   for j:=1 to length(imie) do	   imie[j]:=upcase(imie[j]);   writeln('Podaj oceny: ');   oceny('Dalej - ');  end;  write(plik,dane);  repeat   clrscr;   writeln('Kontynuowac? (T/N)');   dec:=readkey;   dec:=upcase(dec);  until (dec='T') or (dec='N');end;{----------------------------PROCEDURA WYKONAWCZA----------------------------}procedure zapis;begin clrscr; write('Podaj nazwe pliku: '); readln(nazwa1); if jest_plik(nazwa1) then  begin   repeat	clrscr;	writeln('Plik "',nazwa1,'" juz istnieje!');	writeln('Czy chcesz go usunac? (T/N)');	readln(dec);	dec:=upcase(dec);   until (dec='T') or (dec='N');   if dec='N' then exit  end;  assign(plik,nazwa1);  rewrite(plik);  repeat   pytanie;  until dec='N';  close(plik);end;

i KOREKTA

{----------------------------PROCEDURA POMOCNICZA----------------------------}procedure kor_1;var nr_ko:longint;	dec1:char;begin reset(plik); repeat  write('Ktora pozycje poprawic?: ');  readln(nr_ko);  if (nr_ko>filesize(plik)) or (nr_ko<=0) then writeln('Niema takiej pozycji'); until (nr_ko<=filesize(plik)) and (nr_ko>0); close(plik); repeat  reset(plik);  repeat   clrscr;   seek(plik,nr_ko-1);   read(plik,dane);   wypis;   writeln;   writeln('KOREKTA');   writeln('Numer ucznia -	   1');   writeln('Nazwisko ucznia -	2');   writeln('Imie ucznia -		3');   writeln('Oceny -			  4');   writeln('Powrot do menu -   <esc>');   dec1:=readkey;  until dec1 in ['1','2','3','4',#27];  seek(plik,nr_ko-1);  with dane,przedm do   case dec1 of   '1': begin		 writeln;		 write('Podaj nowy nr ucznia: ');		 readln(nr);		 for j:=1 to length(nr) do		 nr[j]:=upcase(nr[j]);		end;   '2': begin		 writeln;		 write('Podaj nowe nazwisko ucznia: ');		 readln(nazw);		 for j:=1 to length(nazw) do		 nazw[j]:=upcase(nazw[j]);		end;   '3': begin		 writeln;		 write('Podaj nowe imie ucznia: ');		 readln(imie);		 for j:=1 to length(imie) do		 imie[j]:=upcase(imie[j]);		end;   '4': oceny('Powrot -');   #27: begin		 close(plik);		 exit;		end;   end;   write(plik,dane);   close(plik); until dec1=#27;end;{----------------------------PROCEDURA WYKONAWCZA----------------------------}procedure korekta;var nr_ko:longint;begin clrscr; write('Podaj nazwe pliku: '); readln(nazwa1); if jest_plik(nazwa1) then  begin   assign(plik,nazwa1);   repeat	repeat	 clrscr;	 reset(plik);	 writeln('Plik ',nazwa1,' zawiera ',filesize(plik),' pozycji');	 close(plik);	 writeln;	 writeln('Czego ma dotyczyc korekta?');	 writeln('Wybranej pozycji -	   W');	 writeln('Elementu z pozycji -	 E');	 writeln('Powrot do menu -	   <Esc>');	 writeln;	 dec:=readkey;	 dec:=upcase(dec);	until dec in ['W','E',#27];	case dec of	'W': begin		  reset(plik);		  repeat		   write('Ktora pozycje poprawic?: ');		   readln(nr_ko);		   if (nr_ko>filesize(plik)) or (nr_ko<=0) then writeln('Niema takiej pozycji');		  until (nr_ko<=filesize(plik)) and (nr_ko>0);		  seek(plik,nr_ko-1);		  repeat		   pytanie;		  until dec='N';		  close(plik);		 end;	'E': kor_1;	#27: exit;	end;   until dec=#27;  end else begin	   writeln;	   writeln('Ten plik nie istnieje!');	   readln;	  end;end;

[Leszkon]

no to sobie poradzilem z tym problemem

for j:=1 to 5 do	begin	 dane.przedm.pol.w[j]:=0;	 dane.przedm.ang.w[j]:=0;	 dane.przedm.mat.w[j]:=0;	 dane.przedm.fiz.w[j]:=0;	 dane.przedm.his.w[j]:=0;	end;   dane.przedm.pol.sr:=0;   dane.przedm.ang.sr:=0;   dane.przedm.mat.sr:=0;   dane.przedm.fiz.sr:=0;   dane.przedm.his.sr:=0;

do procedurki pytanie i po kłopocie :D

teraz musze sie tylko uporac z "wywalaniem" np.: przy wpisywaniu zamiast liczb liter a petla repeat_until nie zawsze działa :( i zastanawiam sie czy to

{----------------------------FUNKCJA SPRAWDZAJACA----------------------------}function jest_plik(nazwa:lan):boolean;begin{$I-} assign(plik,nazwa); reset(plik);{$I+} if IOResult=0 then  begin   close(plik);   jest_plik:=true;  end else  jest_plik:=false;end;

mi jakos pomoze uporac sie z tym problemem :D (oczywiscie po odpowiedniej przerobce ;) )

nom to wsio...