Форум программистов
 

Восстановите пароль или Зарегистрируйтесь на форуме, о проблемах и с заказом рекламы пишите сюда - alarforum@yandex.ru, проверяйте папку спам!

Вернуться   Форум программистов > IT форум > Помощь студентам
Регистрация

Восстановить пароль
Повторная активизация e-mail

Купить рекламу на форуме - 42 тыс руб за месяц

Ответ
 
Опции темы Поиск в этой теме
Старый 05.07.2007, 02:42   #1
Mapина
 
Аватар для Mapина
 
Регистрация: 02.07.2007
Сообщений: 9
Вопрос файл Студент-Отличник

процедуры сама добавила...наверное поэтому
не работает...стопорит на
Код:
7 :  convertation(a,fs)"/";
"/" -место где устанавливается курсор
Код:
program Project3;
{$apptype console}
uses
  sysutils,
  windows;
const
  maxkurs = 6; // максимальное кол-во курсов
  maxgroup = 9; // максимальное кол-во групп
  colses = 10; // кол-во сессий для просмотра
  colpred = 2; // кол-во здаваемых предметов на сессии
  maxball = 5;
type
  tstr40=string[40];
  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, a : 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 <= stud.kurs*2) 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 stud.kurs*2 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;
НеЗлаяЯ!

Последний раз редактировалось Mapина; 05.07.2007 в 02:46.
Mapина вне форума Ответить с цитированием
Старый 05.07.2007, 02:44   #2
Mapина
 
Аватар для Mapина
 
Регистрация: 02.07.2007
Сообщений: 9
По умолчанию продолжение

Код:
{редактирование записи в файле}
  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;

procedure assign_file(var a:tfile);
var name:tstr40;
begin
  readln(name);
  assignfile(a,name);
end;
procedure assign_file2(var fs:textfile);
var name:tstr40;
begin
  readln(name);
  assignfile(fs,name);
end;
      {из текстового в типизированный}
procedure convertation(var a:tfile; var fs:textfile );
var
    t:fstud;
    i,j:integer;
begin
  writeln('имЯ текстового');
  assign_file2(fs);
  writeln('имя типизированного');
  assign_file(a);
  reset(fs);
  rewrite(A);
  while not eof(fs) do
    begin
      readln(fs,t.fio);
       if not eof(fs) then readln(fs,t.kurs);
       if not eof(fs) then  readln(fs,t.group);
       if not eof(fs) then  readln(fs,t.form_obuch);
       if not eof(fs) then
         begin
           for i:=1 to t.kurs*2 do
            for j:=1 to colpred do
            begin
              readln (fs,t.uspev[i,j].subject);
              readln(fs,t.uspev[i,j].mark)
           end;
         end;
         readln(fs);
       write(a,t)
   end;
  closefile(fs);
  closefile(A);
end;
       {из типизированного в текстовый}
procedure convertation2 (var a:tfile; var fs:textfile );
var t:fstud;
  i,j:integer;
begin
   writeln('имя типизированного ');
  assign_file2(fs);
  writeln('имя текстового');
  assign_file(a);
  reset (A);
  rewrite(fs);
    while not eof(a) do
     begin
       read(a, t);
       writeln(fs,t.fio);
       writeln(fs,t.kurs);
        writeln(fs,t.group);
        writeln(fs,t.form_obuch);
        for i:=1 to t.kurs*2 do
           for j:=1 to colpred do
           begin
             writeln(fs,t.uspev[i,j].subject,' ');
             writeln(fs,t.uspev[i,j].mark);
           end;
           writeln(fs);
     end;
    closefile(fs);
    closefile(A);
   end;
 
  function Show_menu : byte;
  begin
    repeat
       writeln;
       writeln('  1. создать новый файл');
       writeln('  2. очистить файл');
       writeln('  3. добавить студента');
       writeln('  4. редактировать запись');
       writeln('  5. удалить запись');
       writeln('  6. вывести весь список');
       writeln('  7. текстов->типизир');
       writeln('  8. типизир->текстов');
       writeln('  9. обработать');
       writeln('  0. выход');
       writeln;
       write('выбор: ');
       readln(result);
     until result in [0..9];
  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 :  convertation(a,fs);
       8 :  convertation2(fs,a);
       9 :  find_nerd(f);
      end;
    until ch = 0;
  end;
{основная программа}
begin
  setconsolecp(1251);
  setconsoleoutputcp(1251);
  menu(f);
end.
НеЗлаяЯ!
Mapина вне форума Ответить с цитированием
Старый 05.07.2007, 12:04   #3
Alex21
With best regards
Участник клуба
 
Регистрация: 20.04.2007
Сообщений: 1,448
По умолчанию

var fs:textfile; - в глобальную VAR

Код:
       
7 :  convertation(a,fs);
8 :  convertation2(a,fs);
Alex21 вне форума Ответить с цитированием
Старый 08.07.2007, 23:02   #4
Mapина
 
Аватар для Mapина
 
Регистрация: 02.07.2007
Сообщений: 9
По умолчанию

спасиб....
НеЗлаяЯ!
Mapина вне форума Ответить с цитированием
Ответ


Купить рекламу на форуме - 42 тыс руб за месяц



Похожие темы
Тема Автор Раздел Ответов Последнее сообщение
AVI файл DeDoK Общие вопросы Delphi 6 29.09.2018 15:37
Студент. Экономический календарь из Эхсел в Ахсел olimpus Microsoft Office Access 1 18.07.2008 08:37
Как с поиощью hiew вставить в файл строчку, "раздвинуть" файл и вставить туда строчку? barand Assembler - Ассемблер (FASM, MASM, WASM, NASM, GoASM, Gas, RosAsm, HLA) и не рекомендуем TASM 2 28.06.2008 10:58