Задача На Записи.упорядочить Массив По Среднему Баллу

  • Автор темы natikk3
  • Дата начала
N

natikk3

#1
Создать массив из 20 элементов,хранящих информацию о студенках факультета.Каждый элемент содержит фамилию,курс,форму обучения,(специалист,бакалавр,магис тр)и оценки по 5 предметам за последнюю сессию.
Упорядочить массив по среднему баллу.Осуществить перевод студентов на следующий курс.Переводятся студенты ,не имеющие задолжностей за последнюю сессию,студенты 5-ого курса(специалисты) и 6-ого курса(магистры)должны быть удалены ,как окончившие курс обучения.
Я сделала,но явно неправильно,и кое где несообразила,как дальше.помогите исправить ошибки и дописать то,что совсем неверно.буду очень благодарна!
Код:
program Project2;

{$APPTYPE CONSOLE}

uses
SysUtils,
Windows;

const n=5;
type
formob=(spez,bakal,magis);
zmas=array [1..5]of integer;
telem=record
name:record
FIO:string[30]
curs: 1..6;
end;
pred:zmas;
form:formob;
end;
tmas=array [1..n] of telem;
var
a:tmas;
b:array[1..n]of string[30];// массив студентов,которых переводят
mn,choice,i:Integer;
exit_:char;
error_in: boolean;
Function menu :integer; //Вывод меню на экран
begin
writeln;
writeln (' ','1.Упорядочить массив по среднему баллу');
writeln (' ','2.Перевести студентов на следующих курс');
Writeln (' ','3.Завершение работы.');
repeat
write ('Ваш выбор: ');
readln (choice);
error_in:=(choice<1) or (choice >3);
if error_in then writeln ('Ошибка ввода!')
until not error_in;
menu:=choice;
end;


procedure form (var a:tmas);
var
k,i,j:integer;
b:telem;
n:integer;
tmp:telem;
begin
writeln('Ввести ФИО');
readln(b.name.FIO);
writeln('Ввести номер формы обучения');
readln(k);
case k of
1: b.form:=spez;
2: b.form:=bakal;
3: b.form:=magis
end;
writeln('Ввести курс');
readln(b.name.curs);
writeln('Ввести оценки');
for i:=1 to n do
readln(b.pred[j]);
a[i]:=b
end;

Function Sr(b:zmas):integer;
var
s1,s,i:integer;
begin
S:=0;
for i:=1 to n do
begin
S:=S+S1(b[i].pred);
Sr:=s1 div 5
end;
end;

procedure sort(var b:tmas);
var
i,j:integer;
tmp:telem;
begin
for i:=1 to n do
if(b[i]>b[i+1]) then
begin
tmp:=b[i];
b[i]:=b[i+1];
b[i+1]:=tmp;
end;
end;
Procedure perevod (var b:tmas);
var i,k:integer;
i:=1; k:=0;
while i<= n-k do
//---------------------
Function Dvoechnik (a:tmas);
var i,k:integer;
for i:=1 to n do
Begin
If a[i]<3 then
k:=k+1
end;
//---------------------





SetConsoleOutputCP(1251);
form(а);
writeln;
REPEAT
mn:=Menu;
case mn of
1:begin
sort(а);

end;
2: begin
Writeln('Перевод на следующий курс');

end
end;
if mn<>3 then
begin
Writeln;
write (' ','Завершить работу? (Y/N)');
readln(exit_);
end;
UNTIL (exit_='y') or (exit_='Y') or (choice=3);
readln

End.
 
N

natikk3

#2
а я чуть исправила.осталось доделать процедуру перевода
Код:
program Project2;

{$APPTYPE CONSOLE}

uses
SysUtils,
Windows;

const n=5;
type
formob=(spez,bakal,magis);
Tballs=array[1..5]of 1..5;
telem=record
FIO:string[35]
curs: integer;
f_study:formob;
balls:Tballs;
Med_ball:real;
end;
tmas=array [1..n] of telem;
var
a:tmas;
b:array[1..n]of string[30];
s,mn,choice,i:Integer;
exit_:char;
error_in: boolean;

Function menu :integer; //Вывод меню на экран
begin
writeln;
writeln (' ','1.Упорядочить массив по среднему баллу');
writeln (' ','2.Перевести студентов на следующих курс');
Writeln (' ','3.Завершение работы.');
repeat
write ('Ваш выбор: ');
readln (choice);
error_in:=(choice<1) or (choice >3);
if error_in then writeln ('Ошибка ввода!')
until not error_in;
menu:=choice;
end;


procedure form (var a:tmas);
var
k,i,j:integer;
b:telem;
n:integer;
tmp:telem;
begin
writeln('Ввести ФИО');
readln(b.FIO);
writeln('Ввести номер формы обучения');
readln(k);
case k of
1: b.f_study:=spez;
2: b.f_study:=bakal;
3: b.f_study:=magis
end;
writeln('Ввести курс');
readln(b.curs);
writeln('Ввести оценки');
s:=0;
for i:=1 to n do
begin
readln(b.balls[j]);
s:=s+b.balls[j]
end;
b.med_ball:=s/5;
a[i]:=b
end;


procedure sort(var b:tmas);
var
i,j:integer;
tmp:telem;
begin
for i:=1 to n do
if b[i].med_ball>b[i+1].med_ball then
begin
tmp:=b[i];
b[i]:=b[i+1];
b[i+1]:=tmp;
end;
end;

Procedure perevod (var b:tmas);
var i,k:integer;
i:=1; k:=0; m:=n;
//---------------------
Function Dvoechnik (b:tmas);
var i,k:integer;
for i:=1 to n do
Begin
If a[i]<3 then
k:=k+1
end;
//---------------------
Procedure Delete(k1:Integer;Var b:tmas);
Var i : Integer;
Begin {сдвиг элементов на один влево}
For i:=k1 To n-1 Do
b[n]:= b[i+1]; {i-му элементу присваиваем значение (i+1)-го}
b[n]:=0;{последний элемент равен 0}
End;
//---------------------
while i<=n do
if Dvoechnik(a[i].balls) then
if (course=5) and ( f_study=spez) or (course=6) and ( f_study=magis ) then
begin
Delete(k1);
m:=m-1;
else
a[i].course:= course+1
end;
end;
SetConsoleOutputCP(1251);
form(а);
writeln;
REPEAT
mn:=Menu;
case mn of
1:begin

sort(а);

end;
2: begin
Dvoechnik(d);
Writeln('Перевод на следующий курс');

end
end;
if mn<>3 then
begin
Writeln;
write (' ','Завершить работу? (Y/N)');
readln(exit_);
end;
UNTIL (exit_='y') or (exit_='Y') or (choice=3);
readln

End.