Правила форума
ВНИМАНИЕ!
и что значит сторока
assignfile(fs,'result.txt');
{Создайте файл Студент. На каждом курсе найдите группу(группы),
в которой больше всего отличников.}
program project2;
{$apptype console}
uses
sysutils,
windows;
const
maxkurs = 6; // максимальное кол-во курсов
maxgroup = 9; // максимальное кол-во групп
colses = 1; // кол-во сессий для просмотра
colpred = 2; // кол-во здаваемых предметов на сессии
maxball = 5;
type
tekzam = record
subject : string[10];
mark : 0..maxball;
end;
tsesia = array[1..colpred] of tekzam;
fstud = record
fio : string[40];
kurs : byte;
group : byte;
form_obuch : char;
uspev : array [1..colses] of tsesia;
end;
tfile = file of fstud;
var
f : tfile;
kol : integer;
name : string;
{поиск отличников}
procedure find_nerd(var f : tfile);
var
k, l, ses, predm, max : integer;
kol_otl : array[1..maxkurs,1..maxgroup] of integer;
fs : textfile;
s : string;
ok : boolean;
stud : fstud;
begin
writeln;
for k:=1 to maxkurs do
for l:=1 to maxgroup do
kol_otl[k,l] := 0;
reset(f);
repeat
ses :=1; ok := true;
read(f, stud);
while (ses <= colses) and (ok) do
begin
predm:= 1;
while (predm <= colpred) and (ok) do
begin
ok := (stud.uspev[ses][predm].mark = 5);
inc(predm);
end;
inc(ses);
end;
if ok then inc(kol_otl[stud.kurs, stud.group]);
until (eof(f));
closefile(f);
assignfile(fs,'result.txt');
rewrite(fs);
for k := 1 to maxkurs do
begin
s := ''; max := 0;
for l:= 1 to maxgroup do
if kol_otl[k,l] > max then
begin
max := kol_otl[k,l];
s := inttostr(l);
end
else if (kol_otl[k,l] = max)and(s <> '') then s := s +', '+ inttostr(l);
if s = '' then
begin
writeln('на ',k,'-ом курсе нет отличников.');
writeln(fs,'на ',k,'-ом курсе нет отличников.')
end
else
begin
writeln('на ',k,'-ом курсе большего всего отличников в ',s,'-ой(ых) группе(ах).');
writeln(fs,'на ',k,'-ом курсе большего всего отличников в ',s,'-ой(ых) группе(ах).')
end;
end;
closefile(fs);
end;
{ввод нового студента}
procedure new_stud(var f : tfile; var n : integer);
var
i, j : integer;
stud : fstud;
ch : char;
begin
writeln;
write(' вводи фио: ');
readln(stud.fio);
write(' вводи номер курса[макс - ',maxkurs,']: ');
repeat
readln(stud.kurs);
if (stud.kurs > maxkurs)or(stud.kurs < 0) then write('повтори ввод : ');
until (stud.kurs <= maxkurs)and(stud.kurs >= 0);
write(' вводи номер группы[макс - ',maxgroup,']: ');
repeat
readln(stud.group);
if (stud.group > maxgroup)or(stud.group < 0) then write('повтори ввод : ');
until (stud.group <= maxgroup)and(stud.group >= 0);
write(' вводи форму обучения (целевая - ц; договорная - д): ');
repeat
readln(ch);
if not(ch in ['д','ц']) then write('повтори ввод : ');
until ch in ['д','ц'];
stud.form_obuch := ch;
for i := 1 to colses do
begin
writeln('сессия № ',i);
for j := 1 to colpred do
begin
write(' вводи название предмета: ');
readln(stud.uspev[i][j].subject);
write(' вводи оценку: ');
readln(stud.uspev[i][j].mark);
end;
end;
reset(f);
seek(f,n);
write(f,stud);
closefile(f);
end;
{подключение файла с записями}
procedure create_file(var f : tfile; var name : string);
var
ch : char;
begin
repeat
write('вводи название файла : ');
readln(name);
until length(name) >0;
name := name + '.info';
assignfile(f,name);
if fileexists(name) then
begin
reset(f);
kol := filesize(f);
closefile(f);
end //exist
else
begin
writeln('ошибка!! файл не найден.');
write('создать? (y/n) : ');
repeat
readln(ch);
if not(ch in ['y','n']) then
begin
writeln('ошибка ввода!');
write('повторите ввод : ');
end;
until ch in ['y','n'];
if (ch = 'y') then
begin
rewrite(f);
closefile(f);
end;
end;
end;
{редактирование записи в файле}
procedure redact(var f:tfile);
var
num : integer;
begin
writeln;
write('ввди номер редактируемой записи : ');
repeat
readln(num);
if (num > kol)or(num <= 0) then
begin
writeln('ошибка ввода!');
write('повторите ввод : ');
end;
until not((num > kol)or(num <= 0));
num := num-1;
new_stud(f, num);
end;
{удаление записи из файла}
procedure delete_el(var f:tfile);
var
num,i : integer;
f1 : tfile;
stud : fstud;
begin
writeln;
write('какую запись будем удалять : ');
repeat
readln(num);
if (num > kol) then
begin
writeln('ошибка ввода!');
write('повторите ввод : ');
end;
until num <= kol;
reset(f);
assign(f1, 'tmp.info');
rewrite(f1);
i := 0;
while not(eof(f)) do
begin
inc(i);
read(f, stud);
if (i <> num) then write(f1,stud);
end;
closefile(f1);
closefile(f);
erase(f);
rename(f1, name);
writeln(num,'-ая запись удалена');
end;
{вывод записей на экран}
procedure print_list(var f : tfile);
var
kol,i,j : integer;
stud : fstud;
begin
reset(f);
kol := 0;
while not(eof(f)) do
begin
inc(kol);
read(f, stud);
writeln(kol,'. фио : ',stud.fio);
writeln(' номер курса : ',stud.kurs);
writeln(' номер группы : ',stud.group);
writeln(' форму обучения (целевая - ц; договорная - д): ', stud.form_obuch);
for i := 1 to colses do
begin
writeln(' сессия № ',i);
for j := 1 to colpred do
begin
writeln(' название предмета: ',stud.uspev[i][j].subject);
writeln(' оценка: ',stud.uspev[i][j].mark);
end;
end;
writeln;
end;
closefile(f);
end;
function Show_menu : byte;
begin
repeat
writeln;
writeln(' 1. создать новый файл');
writeln(' 2. очистить файл');
writeln(' 3. добавить студента');
writeln(' 4. редактировать запись');
writeln(' 5. удалить запись');
writeln(' 6. вывести весь список');
writeln(' 7. обработать');
writeln(' 0. выход');
writeln;
write('выбор: ');
readln(result);
until result in [0..7];
end;
procedure menu(var F : tfile);
var
ch : byte;
begin
repeat
ch := Show_menu;
case ch of
1 : create_file(f,name);
2 : begin
rewrite(f); {очистка файла}
closefile(f);
end;
3 : new_stud(f, kol);{добавление записи в конец файла}
4 : redact(f); {редактирование записи}
5 : delete_el(f);
6 : print_list(f);
7 : find_nerd(f);
end;
until ch = 0;
end;
{основная программа}
begin
setconsolecp(1251);
setconsoleoutputcp(1251);
menu(f);
end.
Сообщение отредактировано: Mapина -
