Программа
USES CRT; { Подключение модуля CRT }
CONST FileName='SCHOOL'; { Имя файла с данными }
QuantityMarks=5; { Количество оценок }
TYPE Pupil=record { Тип "Ученик" для файла и буферных переменных }
FamilyName:string[10];
Name:String[10];
Form:record
Year:byte;
Letter:char;
end;
Marks:array [1..QuantityMarks] of byte;
end;
ListPupil=^PupilType; { Список учеников }
PupilType=record { Тип "Ученик" }
FamilyName:string[10];
Name:String[10];
Form:record
Year:byte;
Letter:char;
end;
Marks:array [1..QuantityMarks] of byte;
Next:ListPupil
end;
FileOfPupil=file of Pupil; { Файл учеников }
VAR F:FileOfPupil; { Файл учеников }
School:ListPupil; { Список учеников }
PROCEDURE ReadFile(var F:FileOfPupil;var School:ListPupil);
{ Процедура чтения файла и формирования списка }
Var PupilBuf:Pupil; { Буфер для чтения записи из файла }
MeterMarks:integer; { Счетчик оценок }
MeterChar:integer; { Счетчик символов }
Begin
if not EOF(F)
then
begin
Read(F,PupilBuf); { Чтение записи из файла }
{ Выравнивание длин фамилии и имени: }
with PupilBuf do
begin
for MeterChar:=Length(FamilyName)+1 to 10 do
FamilyName:=FamilyName+' ';
for MeterChar:=Length(Name)+1 to 10 do Name:=Name+' '
end;
{ Создание нового элемента списка: }
New(School);
School^.FamilyName:=PupilBuf.FamilyName;
School^.Name:=PupilBuf.Name;
School^.Form.Year:=PupilBuf.Form.Year;
School^.Form.Letter:=PupilBuf.Form.Letter;
for MeterMarks:=1 to QuantityMarks do
School^.Marks[MeterMarks]:=PupilBuf.Marks[MeterMarks];
ReadFile(F,School^.Next)
end
else School:=nil
End;
PROCEDURE SortList(var School:ListPupil); { Процедура сортировки списка }
Function SecondElementIsMin(First,Second:PupilType):boolean;
{ Функция определения минимального элемента }
begin
if Second.Form.Year<First.Form.Year
then SecondElementIsMin:=TRUE
else if Second.Form.Year>First.Form.Year
then SecondElementIsMin:=FALSE
else if Second.Form.Letter<First.Form.Letter
then SecondElementIsMin:=TRUE
else if Second.Form.Letter>First.Form.Letter
then SecondElementIsMin:=FALSE
else if Second.FamilyName<First.FamilyName
then SecondElementIsMin:=TRUE
else if Second.FamilyName>First.FamilyName
then SecondElementIsMin:=FALSE
else if Second.Name<First.Name
then SecondElementIsMin:=TRUE
else SecondElementIsMin:=FALSE
end;
Var Ref, { Ссылка }
RefPred, { Ссылка на предыдущий элемент }
RefMin, { Ссылка на минимальный элемент }
RefPredMin { Ссылка на элемент предыдущий минимальному }
:ListPupil;
Begin
{ Начальное определение ссылок: }
RefMin:=School;
RefPredMin:=nil;
Ref:=RefMin;
while Ref^.Next<>nil do { Цикл просмотра очереди }
begin
RefPred:=Ref; { Переопределение ссылки на предыдущий элемент }
Ref:=Ref^.Next; { Переопределение ссылки на текщий элемент }
{ Сравнивание минимального элемента с текущим: }
if SecondElementIsMin(RefMin^,Ref^) then begin
{ Переопределение ссылок минимального элемента } RefMin:=Ref;
RefPredMin:=RefPred
end
end;
if RefPredMin<>nil then begin
{ Если минимальный элемент не первый, то перестановка минимального элемента
в начало очереди } RefPredMin^.Next:=RefMin^.Next;
RefMin^.Next:=School;
School:=RefMin
end;
if School^.Next<>nil then SortList(School^.Next)
{ Если есть хвост очереди, то - сортировка хвоста }
End;
PROCEDURE OutList(School:ListPupil); { Процедура вывода списка }
Procedure OutPupil(Pupil:ListPupil); { Процедура вывода записей учеников }
Var MeterMarks:integer; { Счетчик оценок }
MediumMark:real; { Средний балл }
Begin
if Pupil<>nil { Если запись существует, }
then { то - вывод записи }
with Pupil^ do
begin
Write('║ ',FamilyName,' ',Name,' ║ ', { Вывод фамилии, имени, }
Form.Year:2,Form.Letter,' ║ '); { класса }
MediumMark:=0; { Сброс среднего балла }
for MeterMarks:=1 to QuantityMarks do { Набор суммарной оценки }
MediumMark:=MediumMark+Marks[MeterMarks];
MediumMark:=MediumMark/QuantityMarks; { Пересчет среднего балла }
for MeterMarks:=1 to QuantityMarks do { Цикл вывода оценок }
if Marks[MeterMarks]>0 then Write(Marks[MeterMarks])
else Write('.');
WriteLn(' ║ ',MediumMark:4:1,' ║'); { Ввыод среднего балла }
OutPupil(Pupil^.Next) { Вывод хвоста очереди }
end;
End;
Begin
ClrScr; { Очистка экрана }
{ Вывод шапки таблицы }
WriteLn('╔═══════════════════════╦═════╦════════╦═══════╗');
WriteLn('║ Фамилия Имя ║Класс║ Оценки ║Ср.балл║');
WriteLn('╠═══════════════════════╬═════╬════════╬═══════╣');
OutPupil(School); { Вывод очереди }
{ Закрытие таблицы: }
WriteLn('╚═══════════════════════╩═════╩════════╩═══════╝');
End;
PROCEDURE DisposerTurn(var S:ListPupil); { Процедура уничтожения очереди }
Begin
if S<>nil then begin DisposerTurn(S^.NEXT); Dispose(S) end;
S:=nil
End;
BEGIN
Assign(F,FileName); { Связывание файловой переменной с именем файла }
Reset(F); { Открытие файла под чтение }
ReadFile(F,School); { Чтение файла и формирование списка }
if School<>nil then SortList(School); { Сортировка списка }
OutList(School); { Вывод списка }
Close(F); { Закрытие файла }
DisposerTurn(School) { Уничтиожение очереди }
END.
Бесплатные примеры программ
Примеры написанных программ
Помощь студентам по программированию