17.7.6.Пример работы с типизированными файлами из записей

Создать файл из записей, где первое поле – фамилия, второе поле – год окончания мехмата. Исходные данные ввести с клавиатуры, признаком окончания ввода служит строка '---' при вводе фамилии.

Найти выпускника, ранее всех закончившего мехмат.

Переписать в новый файл такого же типа записи о выпускниках заданного года. Выдать оба файла на экран.

program File_Rec;

type stud=record

FIO:string[15];

year:word

end;

Fstud= file of stud;

var F1,F2: Fstud; //Файлы из записей

name1, name2: string[10];

Y: word; //Заданный год окончания

const tabs= #9#9; //Табуляция для вывода на экран

procedure Creat_F(var F:Fstud);

var s: stud;

begin

repeat

write(’FIO или ---:’); readln(s.FIO);

if s.FIO = ’---’ then break;

write(’year:’);

readln(s.year);

write(F, s)

until false;

end;

procedure Print_F(var F:Fstud);

var s: stud;

begin

while not Eof(F) do

begin

read(F, s);

writeln(s.FIO, tabs, s.year)

end

end;

procedure Min_Year(var F:Fstud);

var s, min: stud; //Запись min для выпускника с минимальным годом выпуска

begin

min.FIO:=''; //Начальные значения

min.year:=Maxint; //перед циклом поиска

while not Eof(F) do

begin

read(F, s); //Чтение записи

if (s.year < min.year) //Если год из записи меньше минимального года,

then min:=s //то запоминание нового минимального

end;

writeln(min.FIO, tabs, min.year) //Вывод записи с минимальным годом

end;

procedure F_F(var F1,F2:Fstud; Y:word);

var s: stud;

begin

while not Eof(F1) do

begin

read(F1, s); //Чтение записи

if (s.year=Y) //Если год из записи файла совпадает с заданным годом

then write(F2, s) //то копирование записи в файл F2

end

end;

begin

//______ Файл выпускников ______

write('Имя файла1:'); readln(name1);

Assign(F1, name1);

Rewrite(F1);

writeln(' Ввод данных для файла выпускников:');

Creat_F(F1);

Reset(F1);

writeln(' Файл выпускников:');

Print_F(F1);

writeln(' Выпускник, ранее других окончивший мехмат');

Reset(F1);

Min_Year(F1);

//______ Файл выпускников заданного года ______

write('Имя файла2:'); readln(name2);

Assign(F2, name2);

Rewrite(F2);

write('Год выпуска:'); readln(Y);

Reset(F1);

F_F(F1,F2,Y);

writeln(' Файл выпускников ', Y, ' года:');

Reset(F2);

Print_F(F2);

Close(F1);

Close(F2);

end.

18.Процедурные типы

18.1.Назначение процедурных типов

Процедурные типы позволяют трактовать процедуры и функции как значения, которые можно присваивать переменным процедурного типа и передавать в качестве параметров другим процедурам и функциям.

Процедурные переменные используются для вызова подпрограмм, которые присвоены этим переменным.

Процедурные переменные содержат ссылку на код процедуры или функции.

18.2.Описание процедурных типов и процедурных переменных

Существует две разновидности процедурных типов: тип-процедура и тип-функция.

Описание процедурных типов аналогично заголовку процедуры и функции, за исключением того, что отсутствует идентификатор процедуры и функции.

Например:

Type

TStrProc=procedure(n:integer; var S:string);{Описание типа-процедуры с целочисленным параметром

и параметром строкой}

TPr=procedure; {Описание типа-процедуры без параметров}

TFunc=function(a, b:integer):integer; {Описание типа-функции с двумя целочисленными параметрами

и целочисленным результатом}

var ps: TstrProc; {Описание процедурных переменных}

p: Tpr;

f1,f2: TFunc;