Упорядочить массив по среднему баллу, задача на Записи Опции

[natik3]

Создать массив из 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.

[Krjuger]

Тут есть 2 варианта,либо сначала повысить всем,а потом удалить тех кто привысил лимит, либо повыщать только тем,кто не заканчикает универ, а остальных сразу удалять.
Вот пример второго варианта, осталось только функцию удаления написать)

for i:=n  downto 1 do
        begin
         if ((a[i].f_study=magis) and (a[i].curs<6)) or ((a[i].f_study=spez) and (a[i].curs<5)) or ((a[i].f_study=bacal) and (a[i].curs<4)) then
            a[i].curs:=a[i].curs+1
         else
             Delete(a,i);
        end;

Ее попробуйте сами сделать)

Сообщение отредактировано: Krjuger - 22.05.2012 17:34

[natik3]

Тут есть 2 варианта,либо сначала повысить всем,а потом удалить тех кто привысил лимит, либо повыщать только тем,кто не заканчикает универ, а остальных сразу удалять.
Вот привер второго варианта, осталось только функцию удаления написать)

for i:=n  downto 1 do
        begin
         if ((a[i].f_study=magis) and (a[i].curs<6)) or ((a[i].f_study=spez) and (a[i].curs<5)) or ((a[i].f_study=bacal) and (a[i].curs<4)) then
            a[i].curs:=a[i].curs+1
         else
             Delete(a,i);
        end;

ну вот смотри,что получилось..только вот функция по поиску двоичников и удаления K элемента...явно что то не то...

Код

Procedure perevod (var b:tmas);
var i,k:integer;
i:=1; k:=0;  d:=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];
b[n]:=0;
End;
   //---------------------
while i<=n do
if Dvoechnik(a[i].balls) then

for i:=1 to n do
        begin
        if Dvoechnik(a[i].balls) then

for i:=1 to n do
     if (course=5) and ( f_study=spez) or (course=6) and  ( f_study=magis ) then
         begin
           Delete(k1);
           d:=d-1;
         else
       a[i].curs:=a[i].curs+1;
          end;
          end;
          

Сообщение отредактировано: natik3 - 22.05.2012 17:32