студенты-отличники, процедура поиска Опции

[Mapина]

В изложенной мной задаче в процедуре поиска отличников предметы зависят от №сессии, а необходимо чтоб сессия зависила от предметов. Спасибо!

и что значит сторока

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ина - 1.07.2007 20:07