динамические списки, немного доделать Опции

[kreator]

program kursov;
uses crt;
type
student=record
  name,part,prof:string[23];                        {имя и инициалы}
  number,vozrast:integer;                         {номер группы}
 { ball:array[1..5] of integer;}            {успеваемость}
  {srball:real;}			          {средняя оценка}
end;

var
  f1,f2:file of student;                 {файловая переменная массива}
  zap:student;
  repeatkey:char;
  num:integer;                           {общее количество записей в массиве}
  i,j:integer;
  gg,gg2,gg3,sor:longint;
  sel:integer;                           {выбор пункта меню}
  sum:longint;                           {сумма значений полей}
  m1,m2:student;                         {для сортировки записей}
  s:boolean;                             {ключ сортировки}
  filename:string;                       {имя файла с записями}
  z:string;                              {фильтрация пробелов}
  pball:string[9];                       {Оценки для ввода и вывода}

{описание вспомогательных процедур}
{!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!}
procedure shapka;                         {заголовок таблицы}
	begin
		writeln ('                      TABLICA ZAPISEU');
		writeln;
		writeln ('/===============TT==========TT==========TT=========TT=============\');
		writeln ('[ fAMILIIA I.O. ][  #okryga ][ vozrast  ][ partiia ][  professiia ]');
		writeln ('\===============++==========++==========++=========++=============/');
	end;
{!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!}
procedure undertable;                         {низ таблицы}
	begin
		writeln ('\==================¦===========¦===========¦==========+===========/');
	end;
{!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!}
procedure nofile;                         {отсутствие файла}
	begin
		clrscr;
		writeln;
		writeln ('                          OSHIBKA!');
		writeln ('       Faul ',filename,' otsytstvyet! Najmite Enter.');
		readkey;
	end;
{!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!}
procedure opening;                         {процедура открытия файла с f1}
	begin
		writeln;
		write ('                      VVedite imia faula ');
		readln (filename);
		assign (f1,filename);
	end;
{!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!}
procedure printing;                         {процедура вывода текущей строки}
	begin
		with zap do
			begin
				write ('¦ ',name:5,'     ');
				write (number:10,'   ');
				pball:='';
{формирование строки оценок и вывод на экран}
                                write (vozrast:10,'   ');

                                 write (part:10,'  ');
                                  write (prof:10,'  ');
                                  writeln;
			end;
	end;
{!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!}
procedure obmen;
	begin
		sor:=sor-2;
		seek(f1,sor);
		write(f1,m2);
		write(f1,m1);
		sor:=sor+2;
		sor:=sor-1;
		seek(f1,sor);
	end;
{!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!}
procedure editforedit;					{Процедура выбора пункта изменения и изменения}
	begin
		repeat
		clrscr;
		Writeln('                       vy xotite izmenit:');
		Writeln('                        -----------------------');
		Writeln('                            1. familiy I.O.');
		Writeln('                            2. Nomer okryga');
		Writeln('                            3. vozrast');
                Writeln('                            4. naimen partii');
                Writeln('                            5. professiy');
		Writeln('                        -----------------------');
		Write('                       >>');
		Readln(sel);
		clrscr;
		writeln;
		writeln ('                        zapis ',gg);
		writeln;
		writeln ('                      vvedite novye dannye: ');
		writeln;
		case sel of
		1:begin
			write ('                      familiia i.o. ');
			readln (zap.name);
			writeln;
			writeln('                     familiia v zapisi ',gg,' izmenena');
		end;
		2:begin
			write ('                      # okryga ');
			readln (zap.number);
			writeln;
			writeln('                    # okryga',gg,' izmenen');
		end;
		3:begin

			writeln ('                    vvedite novyu vozrast');
				readln (zap.vozrast);
                                writeln('                   vozrast  ',gg,' izmenen');

			end;
                4:begin
			write ('                      Naim partii ');
			readln (zap.part);
			writeln;
			writeln('                     naim partii ',gg,' izmeneno');
		end;
                5:begin
			write ('                     professiia ');
			readln (zap.prof);
			writeln;
			writeln('                     professiia ',gg,' izmenena');
		end;
{Подсчет Среднего Балла}
			{sum:=0;
			for j:=1 to 5 do
			sum:=sum+zap.ball[j];
			zap.srball:=sum/5; }

			{writeln('                   vozrast  ',gg,' izmenen');
		end;     }
		end;
		clrscr;
		Writeln;
		Write('   vy xotite izmenit chto nibyd eshe ? [Y/N] либо [Д/Н] ');
		Readln(repeatkey);
		until (UpCase(repeatkey) in ['N','Н']);
		seek(f1,gg-1);
		write(f1,zap);
	end;

{Основные подпрограммы 1-7}
{!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!}
procedure create;                             {процедура создания нового файла}{(1 подпрограмма)}
	begin
		clrscr;
		Writeln('          vvedite imia faula');
		Write('        ');
		Readln(filename);
		Assign(f1,filename);
		Rewrite(f1);
		Writeln('          faul s imenem ',filename,' sozdan. najmite ENTER.');
		readkey;
		close(f1);
	end;                             {процедура создания нового файла}{(конец 1 подпрограммы)}
{!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!}
procedure enter; 			{процедура добавления записи в файл}{(2 подпрограмма)}
	begin
		clrscr;					{ассоциация с файлом и переход в конец}
		writeln ('                     dobavlenie zapisi v faul');
		opening;
		{$I-}
		reset (f1);
		{$I+}
		if IOResult=0 then
		begin
			if not eof(f1) then
			begin
				gg:=filesize(f1);
				seek(f1,gg);
			end;
		clrscr;
		writeln ('                      vvod zapiseu');
		writeln;
		write ('                      vvedite kol-vo zapiseu ');
		readln (num);
		for i:=1 to num do
		begin
			clrscr;
			writeln;
			writeln ('                     zapis ',i);
			with zap do
			begin

				write (' familiia i.o. ');
				readln (name);
				write ('# okryga ');
				readln (number);

				writeln (' vozrast : ');

			       readln (vozrast);
                               writeln ('Naimenovanie partii : ');

			       readln (part);
                               writeln (' professia ');

			       readln (prof);
					end;



			write(f1,zap);
                      writeln;
		end;
		close(f1);
		end
		else nofile;
	end; 			{процедура добавления записи в файл}{(конец 2 подпрограммы)}
{!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!}
procedure udalen;                             {процедура удаления записи}{(3 подпрограмма)}
	begin
		clrscr;
		writeln ('                      ydalenie zapisi iz faula');
		opening;
		{$I-}
		reset (f1);
		{$I+}
		if IOResult=0 then
			begin
				assign (f2,'buf');
				rewrite (f2);
				clrscr;
				writeln ('                      ydalenie zapisi');
				writeln;
				write ('                      vvedite nomer zapisi ');
				readln (num);
				for i:=1 to num-1 do
				begin
					read(f1,zap);
					write(f2,zap);
				end;
				read(f1,zap);
				while (not(eof(f1))) do
				begin
					read(f1,zap);
					write(f2,zap);
				end;
				close(f1);
				close(f2);
				erase(f1);
				rename(f2,filename);
				clrscr;
				Writeln('          zapis ',num,' ydalena. najmite ENTER.');
				readkey;
			end
		else nofile;
	end;                             {процедура удаления записи}{(конец 3 подпрограммы)}
{!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!}
procedure edit;                             {процедура корректировки записи}{(4 подпрограмма)}
	begin
		clrscr;
		repeatkey:=' ';
		writeln ('                      korrektirovka zapisi v faule');
		opening;
		{$I-}
		reset (f1);
		{$I+}
		if IOResult=0 then
			begin
				repeat
				clrscr;
				writeln ('                      korrektirovka zapisi');
				writeln;
				write ('                      vvedite nomer zapisi ');
				readln (gg);
				seek(f1,gg-1);
				read(f1,zap);
				editforedit;
				clrscr;
				Writeln;
				Write('  vy xotite izmenit drygyy zapis? [Y/N] libo [Д/Н] ');
				Readln(repeatkey);
				until (UpCase(repeatkey) in ['N','Н']);
				close(f1);
			end
		else nofile;
	end;                             {процедура корректировки записи}{(конец 4 подпрограммы)}
{!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!}
procedure view;                         {вывод массива на экран}{процедура просмотра файла}{(5 подпрограмма)}
	begin
		clrscr;
		writeln ('                      prosmotr faula');
		opening;
		{$I-}
		reset (f1);
		{$I+}
		if IOResult=0 then
		begin
			clrscr;
			shapka;
			while (not Eof(f1)) do
				begin
					read(f1,zap);
					with zap do
					printing;
				end;
			undertable;
			readkey;
		end
		else nofile;
	end;                         {вывод массива на экран}{процедура просмотра файла}{(конец 5 подпрограммы)}
{!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!}
procedure disp;                             {процедура вывода на дисплей при условии}{(7 подпрограмма)}
	begin
		clrscr;
		writeln;
		opening;
		{$I-}
		reset (f1);
		{$I+}
		if IOResult=0 then
		begin
			clrscr;
			shapka;
			s:=false;

			while (not Eof(f1)) do
			begin
				read(f1,zap);
				with zap do
				if vozrast>4 then
				begin
					printing;
					s:=true;
				end;
			end;
			if s=false then writeln ('¦ poisk neydachen          ¦            ¦              ¦          ¦');
			undertable;
			readkey;
		end
		else nofile;
	end;                             {процедура вывода на дисплей при условии}{(конец 7 подпрограммы)}
{!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!}
BEGIN
	repeat
	clrscr;
	writeln;
	writeln ('                      ychebnaia praktika');
	writeln;
	writeln;
	writeln ('                  baza dannyx ======== Kandidaty');
	writeln;
	writeln ('                  ------------------------------------');
	writeln ('                     1. Sozdanie faula');
	writeln ('                     2. Dobavlenie zapisi v faul');
	writeln ('                     3. Ydalenie ykazannou zapisi');
	writeln ('                     4. Korektirovka ykazannou zqapisi');
	writeln ('                     5. Prosmotr faula');
	writeln ('                     6. tyt doljen byt poisk');
	writeln ('                     7. vyxod');
	writeln ('                  ------------------------------------');
	writeln;
	write   ('                  > ');
	readln (sel);
	case sel of
		1:create;
		2:enter;
		3:udalen;
		4:edit;
		5:view;
		6:disp;
		7:break;
	end;
	until false;
END.

pomogite plz vmesto procedyry disp sdekat poisk xotia by po imeni
i eshe sdelat' vyxo bez soxraneniia


zaranee spasibo