IPB
ЛогинПароль:

> Прочтите прежде чем задавать вопрос!

1. Заголовок темы должен быть информативным. В противном случае тема удаляется ...
2. Все тексты программ должны помещаться в теги [code=pas] ... [/code], либо быть опубликованы на нашем PasteBin в режиме вечного хранения.
3. Прежде чем задавать вопрос, см. "FAQ", если там не нашли ответа, воспользуйтесь ПОИСКОМ, возможно такую задачу уже решали!
4. Не предлагайте свои решения на других языках, кроме Паскаля (исключение - только с согласия модератора).
5. НЕ используйте форум для личного общения, все что не относится к обсуждению темы - на PM!
6. Одна тема - один вопрос (задача)
7. Проверяйте программы перед тем, как разместить их на форуме!!!
8. Спрашивайте и отвечайте четко и по существу!!!

2 страниц V  1 2 >  
 Ответить  Открыть новую тему 
> Упорядочить массив по среднему баллу, задача на Записи
сообщение
Сообщение #1


Новичок
*

Группа: Пользователи
Сообщений: 34
Пол: Женский

Репутация: -  0  +


Создать массив из 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.
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #2


Профи
****

Группа: Пользователи
Сообщений: 652
Пол: Мужской
Реальное имя: Алексей

Репутация: -  20  +


Окей,поможем, давайте только вы скажете,что именно не работает, что не можете придумать.
Еще я не улавливаю смысла делать в record еще один record.И еще 1 вопрос:"Вы используете Builder?"
Насчет процедуры form;

for i:=1 to n do
readln(b.pred[j]);
a[i]:=b


Нигде в вашей функции j больше не фигурирует, так что оно работать не будет,а точнее если j инициализируется нулем,то запись будет всегда производиться в 1 и ту же ячейку,а если каким нибудь значением за пределами нашего массива,так вообще вылетит с ошибкой.

Сообщение отредактировано: Krjuger -
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #3


Новичок
*

Группа: Пользователи
Сообщений: 34
Пол: Женский

Репутация: -  0  +


Цитата(Krjuger @ 22.05.2012 11:58) *

Окей,поможем, давайте только вы скажете,что именно не работает, что не можете придумать.
Еще я не улавливаю смысла делать в record еще один record.И еще 1 вопрос:"Вы используете Builder?"
Насчет процедуры form;

for i:=1 to n do
readln(b.pred[j]);
a[i]:=b


Нигде в вашей функции j больше не фигурирует, так что оно работать не будет,а точнее если j инициализируется нулем,то запись будет всегда производиться в 1 и ту же ячейку,а если каким нибудь значением за пределами нашего массива,так вообще вылетит с ошибкой.

я чуть чуть сама исправила свои недочеты.вот что получилось
Код
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.




но я не знаю как осуществить перевод.как правильно сделать функцию удаления и поиска двоичников.
так же,проверьте,если не сложно,правильно ли я сделала сортировку.буду очень благодарна за помощь.
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #4


Профи
****

Группа: Пользователи
Сообщений: 652
Пол: Мужской
Реальное имя: Алексей

Репутация: -  20  +


Давайте не лезть вперед паровоза,у вас и без удаления много ошибок,щас будем потихоньку разгребать.Кстати скажите,что за компилятор вы используете?
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #5


Новичок
*

Группа: Пользователи
Сообщений: 34
Пол: Женский

Репутация: -  0  +


Цитата(Krjuger @ 22.05.2012 14:26) *

Давайте не лезть вперед паровоза,у вас и без удаления много ошибок,щас будем потихоньку разгребать.Кстати скажите,что за компилятор вы используете?

Delphi 7
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #6


Профи
****

Группа: Пользователи
Сообщений: 652
Пол: Мужской
Реальное имя: Алексей

Репутация: -  20  +


Значит так,начнем разбор полетов.

Tballs=array[1..5]of 1..5;
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;


Я уже писал j у нас нигде не меняется и не участвует!!!!!!!!!Если мы считываем и суммируем оценки за предмет,то нам нужна изменяющаяся переменная.
Меняем.
readln(b.balls[i]);
s:=s+b.balls[i];
Но теперь возникла проблема, если мы изменим n например на 6, то мы будем считать 6 предметов,а тип Tballs у нас описан как массив строго из 5 элементов, исправляем.
Tballs=array[1..n]of 1..5;
Продолжаем, у нас получатся,что количество студентов навно n и количество предметов у каждого студента равно n, это непорядок, вводим вторую константу m.Пускай n- кол во студентов,а m- кол-во предметов.
В общем немного поработав с твоим кодом родилось нечто подобное.

const n=3;
const m=3;
type
formob=(spez,bakal,magis);
Tballs=array[1..m] 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;


function menu :integer;
var
choice:integer;
error_in: boolean;
begin
writeln;
writeln (' ','1.Sorting');
writeln (' ','2.Up');
writeln (' ','3.Exit');
error_in:=false;
repeat
write ('Choice: ');
readln (choice);
error_in:=(choice<1) or (choice >3);
if error_in then
writeln ('Error!')
until not error_in;
menu:=choice;
end;

procedure Add (var a:telem);
var
k,i:integer;
b:telem;
s:integer;
begin
writeln('FIO');
readln(b.FIO);
writeln('Number of Form Educationя');
readln(k);
case k of
1: b.f_study:=spez;
2: b.f_study:=bakal;
3: b.f_study:=magis
end;
writeln('Kurs');
readln(b.curs);
writeln('Marks');
s:=0;
for i:=1 to m do
begin
readln(b.balls[i]);
s:=s+b.balls[i];
end;
b.med_ball:=s/m;
a:=b;
end;

procedure swap(var x,y: telem);
var
t: telem;
begin
t := x;
x := y;
y := t
end;

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

var
a:tmas;
mn,i:integer;
exit_:char;
begin
for i:=1 to n do
Add(a[i]);

writeln;
REPEAT
mn:=Menu;
case mn of
1:begin
sort(a);
for i:=1 to n do
begin
write(a[i].FIO+' ');
writeln(a[i].med_ball:4:4);
end;
end;
2: begin
{Dvoechnik(d); }
Writeln('Перевод на следующий курс');
end;
else
begin
writeln;
write (' ','Завершить работу? (Y/N)');
readln(exit_);
end;
end;
UNTIL (exit_='y') or (exit_='Y') or (mn=3);
readln;
end.


Тут оно еще и сортирует правильно,я надеюсь тебе надо было отсортировать по возрастанию.

А теперь общие коментарии по твоему коду.

Не перескакивай в написании переменных,типов,профедур, и всего остального с заглавные букв на мелкие и обратно, паскаль это кушает, но в большинстве языков это неприемлемо и будут из-за этого ошибки.
Не создавай кучу переменных, которые ты не используешь.
Не нужно создавать глобальные переменные, когда все спокойно делается с локальными.
b:array[1..n]of string[30]; я так и не понял,где это вообще используется и просто удалил,работоспособность не изменилась, тоже самое относится к половине переменных в твоей процедуре form.
choice:integer;
error_in: boolean;
я сделал локальными, они нам просто не нужны как глобальные.
Если программа подразумевает маштабируемость,т.е. изменение размеров массивов,то ненадо использовать числа,иначе потом придется ползать по всех программе и искать их,а так забудешь одно число поменять и будешь получать вылеты за границы массива,оно тебе надо?

Сообщение отредактировано: Krjuger -
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #7


Новичок
*

Группа: Пользователи
Сообщений: 34
Пол: Женский

Репутация: -  0  +


Цитата(Krjuger @ 22.05.2012 15:23) *

Значит так,начнем разбор полетов.

Tballs=array[1..5]of 1..5;
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;


Я уже писал j у нас нигде не меняется и не участвует!!!!!!!!!Если мы считываем и суммируем оценки за предмет,то нам нужна изменяющаяся переменная.
Меняем.
readln(b.balls[i]);
s:=s+b.balls[i];
Но теперь возникла проблема, если мы изменим n например на 6, то мы будем считать 6 предметов,а тип Tballs у нас описан как массив строго из 5 элементов, исправляем.
Tballs=array[1..n]of 1..5;
Продолжаем, у нас получатся,что количество студентов навно n и количество предметов у каждого студента равно n, это непорядок, вводим вторую константу m.Пускай n- кол во студентов,а m- кол-во предметов.
В общем немного поработав с твоим кодом родилось нечто подобное.

const n=3;
const m=3;
type
formob=(spez,bakal,magis);
Tballs=array[1..m] 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;
function menu :integer;
var
choice:integer;
error_in: boolean;
begin
writeln;
writeln (' ','1.Sorting');
writeln (' ','2.Up');
writeln (' ','3.Exit');
error_in:=false;
repeat
write ('Choice: ');
readln (choice);
error_in:=(choice<1) or (choice >3);
if error_in then
writeln ('Error!')
until not error_in;
menu:=choice;
end;

procedure Add (var a:telem);
var
k,i:integer;
b:telem;
s:integer;
begin
writeln('FIO');
readln(b.FIO);
writeln('Number of Form Educationя');
readln(k);
case k of
1: b.f_study:=spez;
2: b.f_study:=bakal;
3: b.f_study:=magis
end;
writeln('Kurs');
readln(b.curs);
writeln('Marks');
s:=0;
for i:=1 to m do
begin
readln(b.balls[i]);
s:=s+b.balls[i];
end;
b.med_ball:=s/m;
a:=b;
end;

procedure swap(var x,y: telem);
var
t: telem;
begin
t := x;
x := y;
y := t
end;

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

var
a:tmas;
mn,i:integer;
exit_:char;
begin
for i:=1 to n do
Add(a[i]);

writeln;
REPEAT
mn:=Menu;
case mn of
1:begin
sort(a);
for i:=1 to n do
begin
write(a[i].FIO+' ');
writeln(a[i].med_ball:4:4);
end;
end;
2: begin
{Dvoechnik(d); }
Writeln('Перевод на следующий курс');
end;
else
begin
writeln;
write (' ','Завершить работу? (Y/N)');
readln(exit_);
end;
end;
UNTIL (exit_='y') or (exit_='Y') or (mn=3);
readln;
end.


Тут оно еще и сортирует правильно,я надеюсь тебе надо было отсортировать по возрастанию.

А теперь общие коментарии по твоему коду.

Не перескакивай в написании переменных,типов,профедур, и всего остального с заглавные букв на мелкие и обратно, паскаль это кушает, но в большинстве языков это неприемлемо и будут из-за этого ошибки.
Не создавай кучу переменных, которые ты не используешь.
Не нужно создавать глобальные переменные, когда все спокойно делается с локальными.
b:array[1..n]of string[30]; я так и не понял,где это вообще используется и просто удалил,работоспособность не изменилась, тоже самое относится к половине переменных в твоей процедуре form.
choice:integer;
error_in: boolean;
я сделал локальными, они нам просто не нужны как глобальные.
Если программа подразумевает маштабируемость,т.е. изменение размеров массивов,то ненадо использовать числа,иначе потом придется ползать по всех программе и искать их,а так забудешь одно число поменять и будешь получать вылеты за границы массива,оно тебе надо?


ты не представляешь,как я тебе благодарна...только буду оч признательна,если поможешь разобраться еще с переводом на следующий курс...
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #8


Профи
****

Группа: Пользователи
Сообщений: 652
Пол: Мужской
Реальное имя: Алексей

Репутация: -  20  +


Тут есть 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 -
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #9


Новичок
*

Группа: Пользователи
Сообщений: 34
Пол: Женский

Репутация: -  0  +


Цитата(Krjuger @ 22.05.2012 18:17) *

Тут есть 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 -
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #10


Профи
****

Группа: Пользователи
Сообщений: 652
Пол: Мужской
Реальное имя: Алексей

Репутация: -  20  +


Ненене, ты что то перемудрила.))

procedure LevelUp(var a: tmas;p:integer);
var
i:integer;
begin
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,p,i);
end;
end;

procedure Otchislenie(var a: tmas;p:integer);
var
i:integer;
begin
for i:=n downto 1 do
if a[i]<3 then
Delete(a,n,i);
end;

procedure Delete(var a:tmas;var p:integer ; i:integer);
var
j:integer;
begin
if i<n then
begin
for j:=i+1 to n do
a[j-1]:=a[j];
p:=p+1;
end
else
p:=p+1;
end;


А выводишь на экран так:

for i:=1 to n-p do
begin
write(a[i].FIO+' ');
writeln(a[i].med_ball:4:4);
end;


Забыл предупредить,писал сразу на форум, так что могут быть ошибки.Как только доберусь до компилятора сразу проверю,а пока, если найдешь ошибки,попробуй сама исправить))))

Сообщение отредактировано: Krjuger -
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #11


Новичок
*

Группа: Пользователи
Сообщений: 34
Пол: Женский

Репутация: -  0  +


Цитата(Krjuger @ 22.05.2012 18:53) *

Ненене, ты что то перемудрила.))

procedure LevelUp(var a: tmas;p:integer);
var
i:integer;
begin
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,p,i);
end;
end;

procedure Otchislenie(var a: tmas;p:integer);
var
i:integer;
begin
for i:=n downto 1 do
if a[i]<3 then
Delete(a,n,i);
end;

procedure Delete(var a:tmas;var p:integer ; i:integer);
var
j:integer;
begin
if i<n then
begin
for j:=i+1 to n do
a[j-1]:=a[j];
p:=p+1;
end
else
p:=p+1;
end;


А выводишь на экран так:

for i:=1 to n-p do
begin
write(a[i].FIO+' ');
writeln(a[i].med_ball:4:4);
end;


Забыл предупредить,писал сразу на форум, так что могут быть ошибки.Как только доберусь до компилятора сразу проверю,а пока, если найдешь ошибки,попробуй сама исправить))))

просто преподаватель сказал делать по такой структуре.вот я и пыталась сообразить)))
он тут почему то выдает много ошибок,связанных с несовместимостью типов и ругается на Delete(a,p,i);...и честно признаться я не совсем понимаю что этот оператор делает..прости за мою тормознутость(
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #12


Профи
****

Группа: Пользователи
Сообщений: 652
Пол: Мужской
Реальное имя: Алексей

Репутация: -  20  +


Эх окей))

const n=3;
const m=2;
type
formob=(spez,bakal,magis);
Tballs=array[1..m] 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;


function menu :integer;
var
choice:integer;
error_in: boolean;
begin
writeln;
writeln (' ','1.Sorting');
writeln (' ','2.Up');
writeln (' ','3.Exit');
error_in:=false;
repeat
write ('Choice: ');
readln (choice);
error_in:=(choice<1) or (choice >3);
if error_in then
writeln ('Error!')
until not error_in;
menu:=choice;
end;

procedure Add (var a:telem);
var
k,i:integer;
b:telem;
s:integer;
begin
writeln('FIO');
readln(b.FIO);
writeln('Number of Form Educationя');
readln(k);
case k of
1: b.f_study:=spez;
2: b.f_study:=bakal;
3: b.f_study:=magis
end;
writeln('Kurs');
readln(b.curs);
writeln('Marks');
s:=0;
for i:=1 to m do
begin
readln(b.balls[i]);
s:=s+b.balls[i];
end;
b.med_ball:=s/m;
a:=b;
end;

procedure swap(var x,y: telem);
var
t: telem;
begin
t := x;
x := y;
y := t
end;

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

procedure Delete(var a:tmas; var p:integer ; i:integer);
var
j:integer;
begin
if i<n then
begin
for j:=i+1 to n-p do
a[j-1]:=a[j];
end;
p:=p+1;
end;

function LevelUp(var a: tmas; p:integer):integer;
var
i:integer;
begin
for i:=n downto 1 do
begin
if ((a[i].f_study=magis) and (a[i].curs<6)) then
a[i].curs:=a[i].curs+1
else
begin
if ((a[i].f_study=spez) and (a[i].curs<5)) then
a[i].curs:=a[i].curs+1
else
begin
if ((a[i].f_study=bakal) and (a[i].curs<4)) then
a[i].curs:=a[i].curs+1
else
Delete(a,p,i);
end;
end;
end;
LevelUp:=p;
end;

function Otchislenie(var a: tmas;p:integer):integer;
var
flag:boolean;
i,j:integer;
begin
flag:=false;
for i:=n downto 1 do
begin
for j:=1 to m do
begin
if (a[i].balls[j]<3) then
begin
flag:=true;
break;
end;
end;
if (flag=true) then
Delete(a,p,i);
end;
Otchislenie:=p;
end;

var
a:tmas;
mn,i:integer;
exit_:char;
p:integer;
begin
for i:=1 to n do
Add(a[i]);
writeln;
REPEAT
p:=0;
mn:=Menu;
case mn of
1:begin
sort(a);
for i:=1 to n do
begin
write(a[i].FIO+' ');
writeln(a[i].med_ball:4:4);
end;
end;
2: begin
p:=LevelUp(a,p);
p:=Otchislenie(a,p);
for i:=1 to n-p do
begin
write(a[i].FIO+' ');
writeln(a[i].med_ball:4:4);
end;
end;
else
begin
writeln;
write (' ','Завершить работу? (Y/N)');
readln(exit_);
end;
end;
UNTIL (exit_='y') or (exit_='Y') or (mn=3);
readln;
end.


Этот вариант компилируется и даже запускается и что то делает.Я попробовал,чтобы удалило тех,кто закончил (1 человек), и одного отчислил за неуспеваемость, вроде работает дальше программу тестируй сама)))))Если найдешь ошибку, скажешь)))

На Delete(a,p,i) он ругался потому,что сама функция описана ниже,чем место где она используется, поэтому кампилятор не мог понять,откуда ее брать,он наперед заглядывать не умеет.

Сообщение отредактировано: Krjuger -
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #13


Новичок
*

Группа: Пользователи
Сообщений: 34
Пол: Женский

Репутация: -  0  +


Цитата(Krjuger @ 22.05.2012 20:58) *

Эх окей))

const n=3;
const m=2;
type
formob=(spez,bakal,magis);
Tballs=array[1..m] 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;
function menu :integer;
var
choice:integer;
error_in: boolean;
begin
writeln;
writeln (' ','1.Sorting');
writeln (' ','2.Up');
writeln (' ','3.Exit');
error_in:=false;
repeat
write ('Choice: ');
readln (choice);
error_in:=(choice<1) or (choice >3);
if error_in then
writeln ('Error!')
until not error_in;
menu:=choice;
end;

procedure Add (var a:telem);
var
k,i:integer;
b:telem;
s:integer;
begin
writeln('FIO');
readln(b.FIO);
writeln('Number of Form Educationя');
readln(k);
case k of
1: b.f_study:=spez;
2: b.f_study:=bakal;
3: b.f_study:=magis
end;
writeln('Kurs');
readln(b.curs);
writeln('Marks');
s:=0;
for i:=1 to m do
begin
readln(b.balls[i]);
s:=s+b.balls[i];
end;
b.med_ball:=s/m;
a:=b;
end;

procedure swap(var x,y: telem);
var
t: telem;
begin
t := x;
x := y;
y := t
end;

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

procedure Delete(var a:tmas; var p:integer ; i:integer);
var
j:integer;
begin
if i<n then
begin
for j:=i+1 to n-p do
a[j-1]:=a[j];
end;
p:=p+1;
end;

function LevelUp(var a: tmas; p:integer):integer;
var
i:integer;
begin
for i:=n downto 1 do
begin
if ((a[i].f_study=magis) and (a[i].curs<6)) then
a[i].curs:=a[i].curs+1
else
begin
if ((a[i].f_study=spez) and (a[i].curs<5)) then
a[i].curs:=a[i].curs+1
else
begin
if ((a[i].f_study=bakal) and (a[i].curs<4)) then
a[i].curs:=a[i].curs+1
else
Delete(a,p,i);
end;
end;
end;
LevelUp:=p;
end;

function Otchislenie(var a: tmas;p:integer):integer;
var
flag:boolean;
i,j:integer;
begin
flag:=false;
for i:=n downto 1 do
begin
for j:=1 to m do
begin
if (a[i].balls[j]<3) then
begin
flag:=true;
break;
end;
end;
if (flag=true) then
Delete(a,p,i);
end;
Otchislenie:=p;
end;

var
a:tmas;
mn,i:integer;
exit_:char;
p:integer;
begin
for i:=1 to n do
Add(a[i]);
writeln;
REPEAT
p:=0;
mn:=Menu;
case mn of
1:begin
sort(a);
for i:=1 to n do
begin
write(a[i].FIO+' ');
writeln(a[i].med_ball:4:4);
end;
end;
2: begin
p:=LevelUp(a,p);
p:=Otchislenie(a,p);
for i:=1 to n-p do
begin
write(a[i].FIO+' ');
writeln(a[i].med_ball:4:4);
end;
end;
else
begin
writeln;
write (' ','Завершить работу? (Y/N)');
readln(exit_);
end;
end;
UNTIL (exit_='y') or (exit_='Y') or (mn=3);
readln;
end.


Этот вариант компилируется и даже запускается и что то делает.Я попробовал,чтобы удалило тех,кто закончил (1 человек), и одного отчислил за неуспеваемость, вроде работает дальше программу тестируй сама)))))Если найдешь ошибку, скажешь)))

На Delete(a,p,i) он ругался потому,что сама функция описана ниже,чем место где она используется, поэтому кампилятор не мог понять,откуда ее брать,он наперед заглядывать не умеет.

ты просто не представляешь,как я тебе благодарна..у меня просто нет слов.огромное тебе спасибо..большое большое..если вдруг,что найду.обязательно скажу.СПАСИБО,еще раз)))
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #14


Новичок
*

Группа: Пользователи
Сообщений: 34
Пол: Женский

Репутация: -  0  +


Цитата(Krjuger @ 22.05.2012 20:58) *

Эх окей))

const n=3;
const m=2;
type
formob=(spez,bakal,magis);
Tballs=array[1..m] 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;
function menu :integer;
var
choice:integer;
error_in: boolean;
begin
writeln;
writeln (' ','1.Sorting');
writeln (' ','2.Up');
writeln (' ','3.Exit');
error_in:=false;
repeat
write ('Choice: ');
readln (choice);
error_in:=(choice<1) or (choice >3);
if error_in then
writeln ('Error!')
until not error_in;
menu:=choice;
end;

procedure Add (var a:telem);
var
k,i:integer;
b:telem;
s:integer;
begin
writeln('FIO');
readln(b.FIO);
writeln('Number of Form Educationя');
readln(k);
case k of
1: b.f_study:=spez;
2: b.f_study:=bakal;
3: b.f_study:=magis
end;
writeln('Kurs');
readln(b.curs);
writeln('Marks');
s:=0;
for i:=1 to m do
begin
readln(b.balls[i]);
s:=s+b.balls[i];
end;
b.med_ball:=s/m;
a:=b;
end;

procedure swap(var x,y: telem);
var
t: telem;
begin
t := x;
x := y;
y := t
end;

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

procedure Delete(var a:tmas; var p:integer ; i:integer);
var
j:integer;
begin
if i<n then
begin
for j:=i+1 to n-p do
a[j-1]:=a[j];
end;
p:=p+1;
end;

function LevelUp(var a: tmas; p:integer):integer;
var
i:integer;
begin
for i:=n downto 1 do
begin
if ((a[i].f_study=magis) and (a[i].curs<6)) then
a[i].curs:=a[i].curs+1
else
begin
if ((a[i].f_study=spez) and (a[i].curs<5)) then
a[i].curs:=a[i].curs+1
else
begin
if ((a[i].f_study=bakal) and (a[i].curs<4)) then
a[i].curs:=a[i].curs+1
else
Delete(a,p,i);
end;
end;
end;
LevelUp:=p;
end;

function Otchislenie(var a: tmas;p:integer):integer;
var
flag:boolean;
i,j:integer;
begin
flag:=false;
for i:=n downto 1 do
begin
for j:=1 to m do
begin
if (a[i].balls[j]<3) then
begin
flag:=true;
break;
end;
end;
if (flag=true) then
Delete(a,p,i);
end;
Otchislenie:=p;
end;

var
a:tmas;
mn,i:integer;
exit_:char;
p:integer;
begin
for i:=1 to n do
Add(a[i]);
writeln;
REPEAT
p:=0;
mn:=Menu;
case mn of
1:begin
sort(a);
for i:=1 to n do
begin
write(a[i].FIO+' ');
writeln(a[i].med_ball:4:4);
end;
end;
2: begin
p:=LevelUp(a,p);
p:=Otchislenie(a,p);
for i:=1 to n-p do
begin
write(a[i].FIO+' ');
writeln(a[i].med_ball:4:4);
end;
end;
else
begin
writeln;
write (' ','Завершить работу? (Y/N)');
readln(exit_);
end;
end;
UNTIL (exit_='y') or (exit_='Y') or (mn=3);
readln;
end.


Этот вариант компилируется и даже запускается и что то делает.Я попробовал,чтобы удалило тех,кто закончил (1 человек), и одного отчислил за неуспеваемость, вроде работает дальше программу тестируй сама)))))Если найдешь ошибку, скажешь)))

На Delete(a,p,i) он ругался потому,что сама функция описана ниже,чем место где она используется, поэтому кампилятор не мог понять,откуда ее брать,он наперед заглядывать не умеет.


у меня появилась вот какая проблема..преподавательница сказала,что двоечников не надо удалять..а функция на проверку двоечников должна быть как условие в функции перевода..что то вроде вот этого..
Код

program str155n10;

{$APPTYPE CONSOLE}

uses
  SysUtils,
  windows;

const n=3;   //кол во студентов
const m=2;    //кол-во предметов
type
    formob=(spez,bakal,magis);
    Tballs=array[1..m] 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;
  function menu :integer;
  var
    choice:integer;
    error_in: boolean;
  begin
      writeln;
      writeln (' ','1.Сортировка по среднему баллу');
      writeln (' ','2.Перевод на следующий курс');
      writeln (' ','3.Exit');
      error_in:=false;
      repeat
            write ('Наш выбар: ');
            readln (choice);
            error_in:=(choice<1) or (choice >3);
            if error_in then
                 writeln ('Error!')
      until not error_in;
      menu:=choice;
  end;

  procedure Add (var a:telem);
  var
   k,i:integer;
   b:telem;
   s:integer;
   begin
     writeln('ФИО');
     readln(b.FIO);
     writeln('Введите номер формы обучения(1.специалист 2.бакалавр 3.магистр)');
     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 m do
     begin
        readln(b.balls[i]);
        s:=s+b.balls[i];
     end;
     b.med_ball:=s/m;
     a:=b;
   end;

   procedure swap(var x,y: telem);
   var
    t: telem;
   begin
    t := x;
    x := y;
    y := t
   end;

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

procedure Delete(var a:tmas; var p:integer; i:integer);
var
j:integer;
begin
if i<n then
  begin
    for j:=i+1 to n-p do
      a[j-1]:=a[j];
  end;
  p:=p+1;
end;

function Good(b:Tballs):boolean;
var
g:boolean;
i,j:integer;
begin
g:=true;  i:=1;
while (i<=5)and g do
     if b[i]<3 then
      begin
       g:=false;
        end
       else
       i:=i+1;
  Good:=g
  end;

function LevelUp (var a: tmas;p:integer):integer;
var
g,i:integer;
begin
for i:=n downto 1 do
  begin
  If Good(a[i].balls)then
  if ((curs=5) and (f_study=spez)) or ((curs=6) and (f_study=magic)) do
  begin
   Delete(a,g,i)
   else
   a[i].curs:=a[i].curs+1
    end;
  end;
  LevelUp:=p
end;

var
   a:tmas;
   mn,i:integer;
   exit_:char;
   p:integer;
begin
setconsolecp(1251);
setconsoleoutputcp(1251);
for i:=1 to n do
  Add(a[i]);
  writeln;
  REPEAT
    p:=0;
    mn:=Menu;
    case mn of
      1:begin
        sort(a);
        for i:=1 to n do
        begin
         write(a[i].FIO+' ');
         writeln(a[i].med_ball:4:4);
        end;
        end;
      2: begin
          p:=LevelUp(a,g);
          for i:=1 to n-p do
          begin
           write(a[i].FIO+' ');
          // writeln(a[i].med_ball:4:4);
          end;
         end;
     else
      begin
       writeln;
       write (' ','Завершить работу? (Y/N)');
       readln(exit_);
      end;
     end;
  UNTIL (exit_='y') or (exit_='Y') or (mn=3);
  readln;
end.

но он выдает куча ошибок,не пойму как их исправить..помогите....
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #15


Профи
****

Группа: Пользователи
Сообщений: 652
Пол: Мужской
Реальное имя: Алексей

Репутация: -  20  +


Вы уж извините,но копаться в том,что вы изменили я не стал, я взял,что сам сделал и изменил.

const n=3;
const m=2;
type
formob=(spez,bakal,magis);
Tballs=array[1..m] 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;


function menu :integer;
var
choice:integer;
error_in: boolean;
begin
writeln;
writeln (' ','1.Sorting');
writeln (' ','2.Up');
writeln (' ','3.Exit');
error_in:=false;
repeat
write ('Choice: ');
readln (choice);
error_in:=(choice<1) or (choice >3);
if error_in then
writeln ('Error!')
until not error_in;
menu:=choice;
end;

procedure Add (var a:telem);
var
k,i:integer;
b:telem;
s:integer;
begin
writeln('FIO');
readln(b.FIO);
writeln('Number of Form Educationя');
readln(k);
case k of
1: b.f_study:=spez;
2: b.f_study:=bakal;
3: b.f_study:=magis
end;
writeln('Kurs');
readln(b.curs);
writeln('Marks');
s:=0;
for i:=1 to m do
begin
readln(b.balls[i]);
s:=s+b.balls[i];
end;
b.med_ball:=s/m;
a:=b;
end;

procedure swap(var x,y: telem);
var
t: telem;
begin
t := x;
x := y;
y := t
end;

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

procedure Delete(var a:tmas; var p:integer ; i:integer);
var
j:integer;
begin
if i<n then
begin
for j:=i+1 to n-p do
a[j-1]:=a[j];
end;
p:=p+1;
end;

function Dvoechnik(var a: telem):boolean;
var
flag:boolean;
i,j:integer;
begin
flag:=false;
for j:=1 to m do
begin
if (a.balls[j]<3) then
begin
flag:=true;
break;
end;
end;
Dvoechnik:=flag;
end;

function LevelUp(var a: tmas; p:integer):integer;
var
i:integer;
begin
for i:=n downto 1 do
begin
if ((a[i].f_study=magis) and (a[i].curs<6)) then
if not Dvoechnik(a[i]) then
a[i].curs:=a[i].curs+1
else
begin
if ((a[i].f_study=spez) and (a[i].curs<5)) then
if not Dvoechnik(a[i]) then
a[i].curs:=a[i].curs+1
else
begin
if ((a[i].f_study=bakal) and (a[i].curs<4)) then
if not Dvoechnik(a[i]) then
a[i].curs:=a[i].curs+1
else
Delete(a,p,i);
end;
end;
end;
LevelUp:=p;
end;


var
a:tmas;
mn,i:integer;
exit_:char;
p:integer;
begin
for i:=1 to n do
Add(a[i]);
writeln;
REPEAT
p:=0;
mn:=Menu;
case mn of
1:begin
sort(a);
for i:=1 to n do
begin
write(a[i].FIO+' ');
writeln(a[i].med_ball:4:4);
end;
end;
2: begin
p:=LevelUp(a,p);
for i:=1 to n-p do
begin
write(a[i].FIO+' ');
writeln(a[i].med_ball:4:4);
end;
end;
else
begin
writeln;
write (' ','Завершить работу? (Y/N)');
readln(exit_);
end;
end;
UNTIL (exit_='y') or (exit_='Y') or (mn=3);
readln;
end.


Проверять щас не могу, проверьте сами,но оно точно откомпилируется.

Сообщение отредактировано: Krjuger -
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #16


Новичок
*

Группа: Пользователи
Сообщений: 34
Пол: Женский

Репутация: -  0  +


Цитата(Krjuger @ 3.06.2012 14:43) *

Вы уж извините,но копаться в том,что вы изменили я не стал, я взял,что сам сделал и изменил.

const n=3;
const m=2;
type
formob=(spez,bakal,magis);
Tballs=array[1..m] 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;
function menu :integer;
var
choice:integer;
error_in: boolean;
begin
writeln;
writeln (' ','1.Sorting');
writeln (' ','2.Up');
writeln (' ','3.Exit');
error_in:=false;
repeat
write ('Choice: ');
readln (choice);
error_in:=(choice<1) or (choice >3);
if error_in then
writeln ('Error!')
until not error_in;
menu:=choice;
end;

procedure Add (var a:telem);
var
k,i:integer;
b:telem;
s:integer;
begin
writeln('FIO');
readln(b.FIO);
writeln('Number of Form Educationя');
readln(k);
case k of
1: b.f_study:=spez;
2: b.f_study:=bakal;
3: b.f_study:=magis
end;
writeln('Kurs');
readln(b.curs);
writeln('Marks');
s:=0;
for i:=1 to m do
begin
readln(b.balls[i]);
s:=s+b.balls[i];
end;
b.med_ball:=s/m;
a:=b;
end;

procedure swap(var x,y: telem);
var
t: telem;
begin
t := x;
x := y;
y := t
end;

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

procedure Delete(var a:tmas; var p:integer ; i:integer);
var
j:integer;
begin
if i<n then
begin
for j:=i+1 to n-p do
a[j-1]:=a[j];
end;
p:=p+1;
end;

function Dvoechnik(var a: telem):boolean;
var
flag:boolean;
i,j:integer;
begin
flag:=false;
for j:=1 to m do
begin
if (a.balls[j]<3) then
begin
flag:=true;
break;
end;
end;
Dvoechnik:=flag;
end;

function LevelUp(var a: tmas; p:integer):integer;
var
i:integer;
begin
for i:=n downto 1 do
begin
if ((a[i].f_study=magis) and (a[i].curs<6)) then
if not Dvoechnik(a[i]) then
a[i].curs:=a[i].curs+1
else
begin
if ((a[i].f_study=spez) and (a[i].curs<5)) then
if not Dvoechnik(a[i]) then
a[i].curs:=a[i].curs+1
else
begin
if ((a[i].f_study=bakal) and (a[i].curs<4)) then
if not Dvoechnik(a[i]) then
a[i].curs:=a[i].curs+1
else
Delete(a,p,i);
end;
end;
end;
LevelUp:=p;
end;
var
a:tmas;
mn,i:integer;
exit_:char;
p:integer;
begin
for i:=1 to n do
Add(a[i]);
writeln;
REPEAT
p:=0;
mn:=Menu;
case mn of
1:begin
sort(a);
for i:=1 to n do
begin
write(a[i].FIO+' ');
writeln(a[i].med_ball:4:4);
end;
end;
2: begin
p:=LevelUp(a,p);
for i:=1 to n-p do
begin
write(a[i].FIO+' ');
writeln(a[i].med_ball:4:4);
end;
end;
else
begin
writeln;
write (' ','Завершить работу? (Y/N)');
readln(exit_);
end;
end;
UNTIL (exit_='y') or (exit_='Y') or (mn=3);
readln;
end.


Проверять щас не могу, проверьте сами,но оно точно откомпилируется.

спасибо большое..а еще вопрос.."break" можно убрать или заменить чем нибудь,а то она ругаетя,когда мы используем его
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #17


Гуру
*****

Группа: Пользователи
Сообщений: 1 013
Пол: Мужской
Ада: Разработчик
Embarcadero Delphi: Сторонник
Free Pascal: Разработчик

Репутация: -  627  +


function Dvoechnik(var a: telem):boolean;
var
j: integer;
begin
Dvoechnik := True;
for j:=1 to m do
begin
if (a.balls[j]<3) then Exit
end;
Dvoechnik := False;
end;
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #18


Профи
****

Группа: Пользователи
Сообщений: 652
Пол: Мужской
Реальное имя: Алексей

Репутация: -  20  +


Странный у вас преподаватель.
break - это функция прерывания цикла до его завершения по условию. Если у нас нет необходимости проходить цикл,а мы идем до первого появления чего-нибудь,то это экономит время,уменьшая время работы программы.Без него можно обходиться,как продемонстрировал IUnknown, но для этого пришлось пораскинуть мозгами, по крайней мере мне точно. И не всегда от него так просто избавиться.
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #19


Новичок
*

Группа: Пользователи
Сообщений: 34
Пол: Женский

Репутация: -  0  +


Цитата(Krjuger @ 3.06.2012 17:59) *

Странный у вас преподаватель.
break - это функция прерывания цикла до его завершения по условию. Если у нас нет необходимости проходить цикл,а мы идем до первого появления чего-нибудь,то это экономит время,уменьшая время работы программы.Без него можно обходиться,как продемонстрировал IUnknown, но для этого пришлось пораскинуть мозгами, по крайней мере мне точно. И не всегда от него так просто избавиться.

что она странная,я согласна...я вас конечно достала,но все же я не могу понять..в последней,вами переделанной версии, она переводит абсолютно всех.т е почему то не удаляет закончивших курс обучения...и условие функции двоечник тоже не выполняется.вы бы не могли бы посмотреть?(
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #20


Профи
****

Группа: Пользователи
Сообщений: 652
Пол: Мужской
Реальное имя: Алексей

Репутация: -  20  +


Да я допустил маленькую ошибочку,bеgin еnd не расставил, щас просто программирую больше на дугом языке.

function LevelUp(var a: tmas; p:integer):integer;
var
i:integer;
begin
for i:=n downto 1 do
begin
if ((a[i].f_study=magis) and (a[i].curs<6)) then
begin
if not Dvoechnik(a[i]) then
a[i].curs:=a[i].curs+1;
end
else
begin
if ((a[i].f_study=spez) and (a[i].curs<5)) then
begin
if not Dvoechnik(a[i]) then
a[i].curs:=a[i].curs+1;
end
else
begin
if ((a[i].f_study=bakal) and (a[i].curs<4)) then
begin
if not Dvoechnik(a[i]) then
a[i].curs:=a[i].curs+1
end
else
Delete(a,p,i);
end;
end;
end;
LevelUp:=p;
end;


Вот так вроде работает.
Но я использовал свое условие,а не IUnknown.
У программы на данный момент есть 1 недостаток.Если например специалист на 5 курсе получает 2, то его не оставляют на 2 год а все равно удаляют. Поскольку, я не знаю,как в этой ситуации поступать, я менять ничего не стал,но если все равно нужно из-за двойки оставлять на том же курсе,то в строчке
if ((a[i].f_study=spez) and (a[i].curs<5)) then

Вместо < ставиться <=, то есть она будет выглядеть.
if ((a[i].f_study=spez) and (a[i].curs<=5)) then

И так для всех трех, бакалавров,спецов и магистров.

Сообщение отредактировано: Krjuger -
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 

2 страниц V  1 2 >
 Ответить  Открыть новую тему 
1 чел. читают эту тему (гостей: 1, скрытых пользователей: 0)
Пользователей: 0

 





- Текстовая версия 25.04.2024 11:19
500Gb HDD, 6Gb RAM, 2 Cores, 7 EUR в месяц — такие хостинги правда бывают
Связь с администрацией: bu_gen в домене octagram.name