Перейти из форума на сайт.

НовостиФайловые архивы
ПоискАктивные темыТоп лист
ПравилаКто в on-line?
Вход Забыли пароль? Первый раз на этом сайте? Регистрация
Компьютерный форум Ru.Board » Компьютеры » Прикладное программирование » Задачи на Pascal/Object Pascal/Free Pascal (Delphi/Lazarus)

Модерирует : ShIvADeSt

 Версия для печати • ПодписатьсяДобавить в закладки
На первую страницук этому сообщениюк последнему сообщению

Открыть новую тему     Написать ответ в эту тему

RAVLLIAN



Newbie
Редактировать | Профиль | Сообщение | ICQ | Цитировать | Сообщить модератору

Код:
 
program GrOb;
uses crt;
const
   max_of_Students = 12;
   surnameLength = 20;
 
type
   Student = record
      fio : string;
      absence : integer;
      mark_2 : integer;
      mark_3 : integer;
      mark_4 : integer;
      mark_5 : integer;
   end;
 
   listOfStudents = array [1..max_of_Students] of Student;
 
var
   flag, sign : boolean;
   list : listOfStudents;
   stud : Student;
   answer : char;
   number : integer;
 
procedure createStudent(var stud : Student);
begin
   with stud do begin
      write ('Введите фамилию студента: ');
      readln (fio);
      write ('введите количество пропусков: ');
      readln (absence);
      write ('Введите количество оценок "5" : ');
      readln (mark_5);
      write ('Введите количество оценок "4" : ');
      readln (mark_4);
      write ('Введите количество оценок "3" : ');
      readln (mark_3);
      write ('Введите количество оценок "2" : ');
      readln (mark_2);
   end;
end;
 
procedure createListofStudent(var count:integer; flag_in:boolean);
var
   add : char;
begin
   while not flag do begin
      count:=count+1;
      createStudent(stud);
      list[count]:=stud;
      sign:=false;
      while not sign do begin
         write ('Вы хотите добавить информацию о следующем студенте? (Y/N): ');
         readln (add);
         case add of
            'N', 'n','Т','т' : begin
               flag:=true;
               sign:=true;
             end;
             'Y', 'y','Н','н' : sign:=true;
             else
                writeln ('Ваш ответ некоректен. Пожалуйста выберите "Y" or "N"');
         end;
      end;
   end;
   writeln;
   writeln ('Количество студентов: ', count);
   writeln;
   flag:=true;
end;
 
procedure listWithoutEstimations (var table : listOfStudents);
var
   i, j : integer;
begin
   j:=0;
   for i:=1 to number do begin
      if table[i].mark_2 = 0 then
         if table[i].mark_3 = 0 then
            if table[i].mark_4 = 0 then
               if table[i].mark_5 = 0 then
                  writeln (table[i].fio)
               else
                  j:=j+1;
   end;
   if j=number then writeln('Нет таких студентов.');
end;
 
procedure list_2 (var table : listOfStudents);
var
   i, j : integer;
begin
   j:=0;
   for i:=1 to number do begin
      if table[i].mark_2 <> 0 then
         writeln (table[i].fio)
      else
         j:=j+1;
   end;
   if j=number then writeln('Нет таких студентов.');
end;
 
procedure list_5and4 (var table : listOfStudents);
var
   i, j : integer;
begin
   j:=0;
   for i:=1 to number do begin
      if (table[i].mark_5 <> 0) and (table[i].mark_4 <> 0) and (table[i].mark_3 = 0) and (table[i].mark_2 = 0) then
         writeln (table[i].fio)
      else
         j:=j+1;
   end;
   if j=number then writeln('Нет таких студентов.');
end;
 
procedure list_5and3 (var table : listOfStudents);
var
   i, j : integer;
begin
   j:=0;
   for i:=1 to number do begin
      if (table[i].mark_5 <> 0) and (table[i].mark_3 <> 0) and (table[i].mark_4 = 0) and (table[i].mark_2 = 0) then
         writeln (table[i].fio)
      else
         j:=j+1;
   end;
   if j=number then writeln('Нет таких студентов.');
end;
 
procedure list_5and4and3 (var table : listOfStudents);
var
   i, j : integer;
begin
   j:=0;
   for i:=1 to number do begin
      if (table[i].mark_5 <> 0) and (table[i].mark_4 <> 0) and (table[i].mark_3 <> 0) and (table[i].mark_2 = 0) then
         writeln (table[i].fio)
      else
         j:=j+1;
   end;
   if j=number then writeln('Нет таких студентов.');
end;
 
procedure list_4and3 (var table : listOfStudents);
var
   i, j : integer;
begin
   j:=0;
   for i:=1 to number do begin
      if (table[i].mark_4 <> 0) and (table[i].mark_3 <> 0) and (table[i].mark_5 = 0) and (table[i].mark_2 = 0) then
         writeln (table[i].fio)
      else
         j:=j+1;
   end;
   if j=number then writeln('Нет таких студентов.');
end;
 
procedure listOfAbsence (var table : listOfStudents);
var
   i, j : integer;
   buffer : Student;
begin
   for i:=1 to number do begin
      for j:=1 to number-i do begin
         if table[j].absence > table[j+1].absence then begin
            buffer:=table[j];
            table[j]:=table[j+1];
            table[j+1]:=buffer;
         end;
      end;
   end;
   for i:=1 to number do begin
      if table[i].absence <> 0 then begin
         write (table[i].fio);
         writeln (table[i].absence:5);
      end;
   end;
end;
 
 
begin
   flag:=false;
   number:=0;
   while not flag do begin
      write ('Вы хотите добавить данные о студенте? (Y/N): ');
      readln (answer);
      case answer of
         'Y', 'y','Н','н' : createListOfStudent(number, flag);
         'N', 'n','Т','т' : exit
         else
            writeln ('Ваш ответ некоректен. Пожалуйста выберите "Y" or "N"');
      end;
   end;
   flag := false;
   while not flag do begin
      writeln ('Пожалуйста выберите одно из следующих:');
      writeln ('1. Студенты, которые не имеют никаких оценок.');
      writeln ('2. Студенты, которые имеют "2".');
      writeln ('3. Студенты, которые имеют "5" и "4".');
      writeln ('4. Студенты, которые имеют "5" и "3".');
      writeln ('5. Студенты, которые имеют "5", "4" и "3".');
      writeln ('6. Студенты, которые имеют "4" и "3".');
      writeln ('7. Студенты, которые прогуляли.');
      writeln ('8. Выход.');
      write ('напишите номер параметра: ');
      readln (answer);
      case answer of
         '1' : begin
            listWithoutEstimations(list);
            write('Нажмите ENTER, чтобы продолжить');
            readln;
         end;
         '2' : begin
            list_2(list);
            write('Нажмите ENTER, чтобы продолжить');
            readln;
         end;
         '3' : begin
            list_5and4(list);
            write('Нажмите ENTER, чтобы продолжить');
            readln;
         end;
         '4' : begin
            list_5and3(list);
            write('Нажмите ENTER, чтобы продолжить');
            readln;
         end;
         '5' : begin
            list_5and4and3(list);
            write('Нажмите ENTER, чтобы продолжить');
            readln;
         end;
         '6' : begin
            list_4and3(list);
            write('Нажмите ENTER, чтобы продолжить');
            readln;
         end;
         '7' : begin
            listOfAbsence(list);
            write('Нажмите ENTER, чтобы продолжить');
            readln;
         end;
         '8' : flag:=true;
      else
         write ('Ваш выбор не правилен. Пожалуйста введите правильные данные: ');
      end;
   end;
end.
 

Всего записей: 16 | Зарегистр. 04-01-2008 | Отправлено: 01:23 05-01-2008 | Исправлено: RAVLLIAN, 14:30 05-01-2008
Открыть новую тему     Написать ответ в эту тему

На первую страницук этому сообщениюк последнему сообщению

Компьютерный форум Ru.Board » Компьютеры » Прикладное программирование » Задачи на Pascal/Object Pascal/Free Pascal (Delphi/Lazarus)


Реклама на форуме Ru.Board.

Powered by Ikonboard "v2.1.7b" © 2000 Ikonboard.com
Modified by Ru.B0ard
© Ru.B0ard 2000-2024

BitCoin: 1NGG1chHtUvrtEqjeerQCKDMUi6S6CG4iC

Рейтинг.ru