Top.Mail.Ru
Ответы
Аватар пользователя
user_261657363
6лет
Изменено
Аватар пользователяПрограммирование

Помогите пожалуйста надо в программу добавить 3 процедуры, они вот такие: функции:

Помогите пожалуйста надо в программу добавить 3 процедуры, они вот такие:
функции:
-список упорядочен по полю группа;
-количество мальчиков в возрасте 17 лет;
-поиск всех студентов, группы " ВС1", родившихся в 1999 году с выводом найденных записей на экран и в файл.
После процедуры sortirovka еще две нужно. Помогите, очень долго пытаюсь и воюю с сортировками . Причем сортировка так и не сработала, массив вне границ оказываеться, не могу понять где ошибка с циклом или где то не так переменные указал. Код программы будет частичен:
Program Facultet1;
Uses crt;
Type
Facultet=Record
FIO:string[25];
Floor:string[1];
Faculte:string[5];
Group:string[6];
God:integer;
end;
Var
a:array[1..100] of Facultet;
i,n: integer;
f: file of Facultet;
zap: Facultet;
vixod: char;
Procedure vvod_danix;
Begin
clrscr;
assign(f, 'c:\Facultet.dat');
rewrite(f);
repeat
writeln('|Введите данные факультета: ');
with zap do
Begin
write('|Введите ФИО.... | - '); readln(FIO);
write('|Введите Пол "М" или "Ж"....| - '); readln(Floor);
write('|Введите название факультета... | - '); readln(Faculte);
write('|Введите название группы.... | - '); readln(Group);
write('|Введите год.... | - '); readln(God);
end;
Write(f,zap);
textcolor(14);
writeln(' ');
write('Для продолжения Ввода данных нежмите ENTER, Для завершения нажмите - 0:',' ',vixod);
readln(vixod);
until vixod='0';
close(f);
end;
Procedure vivod_danyx;
Begin
assign (f,'c:\Facultet.dat');
reset(f);
clrscr;
textcolor(10);
writeln('________________________________________________________________________________');
textcolor(11);
writeln('| Ф. И. О | Пол | Факултет | Группа | Год |');
textcolor(10);
writeln('________________________________________________________________________________');
i:=1;
while not (eof(f)) do
Begin
read(f,zap);
writeln('|',zap.FIO:15,' |',zap.Floor:5,' |',zap.Faculte:7,' |',zap.Group:5,' |',zap.God:6,' |');
textcolor(10);
writeln('________________________________________________________________________________');
i := i + 1;
end;
close(f);
n := i - 1;
textcolor(14);
writeln('Нажмите ENTER для выхода из просмотра файла... *');
readln;
end;
Procedure dobavyt_zap;
Begin
clrscr;
assign (f, 'c:\Facultet.dat');
reset(f);
seek(f,filesize(f));
repeat
writeln('|Введите данные факультета: ');
with zap do
Begin
write('|Введите ФИО.... | - '); readln(FIO);
write('|Введите Пол "М" или "Ж"....| - '); readln(Floor);
write('|Введите название факультета... | - '); readln(Faculte);
write('|Введите название группы.... | - '); readln(Group);
write('|Введите год.... | - '); readln(God);
end;
Write(f,zap);
textcolor(14);
writeln(' ');
write('Для продолжения Ввода данных нежмите ENTER, Для завершения нажмите - 0:',' ',vixod);
readln(vixod);
until vixod='0';
close(f);
end;

Дополнен

Procedure udalenie_zap;
Var
w: byte;
Begin
Begin
assign (f,'c:\Facultet.dat');
reset(f);
clrscr;
textcolor(11);
writeln('________________________________________________________________________________');
textcolor(10);
writeln('| Ф. И. О | Пол | Факултет | Группа | Год |');
textcolor(11);
writeln('________________________________________________________________________________');
i:=1;
while not (eof(f)) do
Begin
read(f,zap);
writeln('|',zap.FIO:15,' |',zap.Floor:5,' |',zap.Faculte:7,' |',zap.Group:5,' |',zap.God:6,' |');
textcolor(10);
writeln('________________________________________________________________________________');
i := i + 1;
end;
end;
reset(f);
assign (f,'c:\Facultet.dat');
textcolor(14);
write('Ввести номер записи для удаления - ');
readln(w);
seek(f, filesize(f) - 1);
read(f, zap);
seek(f, w - 1);
write(f, zap);
seek(f, filesize(f) - 1);
truncate(f);
close(f);
n := i - 1;
Begin
assign (f,'c:\Facultet.dat');
reset(f);
clrscr;
textcolor(11);
writeln('________________________________________________________________________________');
textcolor(10);
writeln('| Ф. И. О | Пол | Факултет | Группа | Год |');
textcolor(11);
writeln('________________________________________________________________________________');
i:=1;
while not (eof(f)) do
Begin
read(f,zap);
writeln('|',zap.FIO:15,

Дополнен

writeln('|',zap.FIO:15,' |',zap.Floor:5,' |',zap.Faculte:7,' |',zap.Group:5,' |',zap.God:6,' |');
textcolor(10);
writeln('________________________________________________________________________________');
i := i + 1;
end;
close(f);
n := i - 1;
textcolor(14);
writeln(' ');
writeln('Нажмите ENTER для выхода... *');
readkey;
end;
end;
Procedure sortirovka;
Var
x:Facultet;
n,i,j:byte;
Begin
assign (f,'c:\Facultet.dat');
reset(f);
clrscr;
textcolor(11);
writeln('________________________________________________________________________________');
textcolor(10);
writeln('| Ф. И. О | Пол | Факултет | Группа | Год |');
textcolor(11);
writeln('________________________________________________________________________________');
i:=1;
while not (eof(f)) do
Begin
read(f,zap);
for i:=1 to n-1 do
for j:=i+1 to n do
if a[i].Group>a[j].Group then
begin
x:=a[i];
a[i]:=a[j];
a[j]:=x;
end;
writeln('|',zap.FIO:15,' |',zap.Floor:5,' |',zap.Faculte:7,' |',zap.Group:5,' |',zap.God:6,' |');
textcolor(10);
writeln('________________________________________________________________________________');
i := i + 1;
end;
close(f);
n := i - 1;
textcolor(14);
writeln(' ');
writeln('Нажмите ENTER для выхода... *');
end;
Begin
repeat
clrscr;
textcolor(10);
writeln('__________________________________________________

Дополнен

Begin
repeat
clrscr;
textcolor(10);
writeln('________________________________________________________________________________');
textcolor(14);
writeln(' Главное Меню программы ');
textcolor(10);
writeln('________________________________________________________________________________');
textcolor(11);
writeln('1 - Создать файл ');
writeln(' ');
textcolor(11);
writeln('2 - Ввывод даных на экран ');
writeln(' ');
textcolor(11);
writeln('3 - Добавить данные ');
writeln(' ');
textcolor(11);
writeln('4 - Удалить записи ');
writeln(' ');
textcolor(11);
writeln('5 - Сортировка по полю группа ');
writeln(' ');
textcolor(11);
writeln('6 - количество мальчиков в возрасте 17 лет ');
writeln(' ');
textcolor(11);
writeln('7 - Поиск группы ВС1, родившихся в 1999 ');
writeln(' ');
textcolor(11);
writeln('8 - Выход ');
textcolor(10);
writeln('________________________________________________________________________________');
textcolor(7);
write ('Ваш выбор: '); readln(n);
case n of
1: vvod_danix;
2: vivod_danyx;
3: dobavyt_zap;
4: udalenie_zap;
5: sortirovka;
6: begin
textcolor(10);
writeln(' ');
write ('Нажмите ENTER для выхода из программы!!!');
readln;
exit;
end;
else
Begin
textcolor(12);
writeln('Нажмите ENTER и продолжите ваш выбор...');
readln end;
end
until n=6;
end.

По дате
По Рейтингу
Аватар пользователя
user_194359843
Искусственный Интеллект
6лет

еще пару раз добавь, что бы пол часа мотали

Больше по теме