Версия для печати темы

Нажмите сюда для просмотра этой темы в обычном формате

Форум «Всё о Паскале» _ Задачи _ паскаль

Автор: Ирин 20.04.2006 2:22

Код
program rgz;
uses Crt;
const
nmenu=7; kmenu=2;
      yn=10;
type
  member=record
        fio: string[40];
        ng: byte;
        opl: char;
        zac: array[1..5] of char;
        ecz: array [1..3] of byte;
  end;
   var
    f:file of member; {переменная для файла с записями member}
    a:member;      {переменная для доступа к записям}
    ft:text;
    i,j:integer;
    st:string;
    c:char;
    t:char;
    menu: array [1..nmenu,1..kmenu] of string;
    b: byte;

procedure Addmember;
var
   {c:char;}
   otvet:string;
   n:integer;
   b:char;
   k:integer;
    begin
     reset(f);
     rewrite(ft);
     seek(f,filesize(f));
         repeat
             cls(15);
             writeln('Добавление нового студента');
             writeln;
              with a do
              begin
                s_fio('Фамилия И.О.: ',a.fio);
                prov_nom('Номер группы: ',a.ng);
                prov_opl('Вид отплаты: ',a.opl);
                writeln('Результаты сдачи 5 зачетов: ') ;
                 for i:=1 to 5 do
                  begin
                   str(i,ts);
                   ts:='Зачет '+ ' '+ ts+ ' ';
                   prov_zac(ts, a.zac[i]);
                 end;
                  write('Результаты сдачи 3 экзаменов: ');
                    for j:=1 to 3 do
                     begin
                       str(j,ts);
                       ts:='Экзамен '+ ' '+ ts+' ';
                       prov_ecz(ts, a.ecz[j]);
                     end;
               end;
           writeln;

           writeln('Продолжить ввод (Д/Н)?');
           readln(otvet);
            write(f,a);
     until (otvet='Н') or (otvet='н');
       close(f);
     close(ft);

end;


procedure korrect;
   var
    p:integer;

    otvet: string;
      begin
      cls(2);
       reset(f);
       rewrite(ft);

       { writeln ('КОРРЕКТИРОВКА ФАЙЛА');
         writeln;  }
            while not (eof(f)) do
             begin
              read(f,a);
               with a do
                begin
                 write(ft,fio,' ',ng,' ',opl);
  writeln(fio,' ',ng,' ',opl);
           writeln('Исправить данные? (Д/Н)?');
           readln(otvet);

        if (otvet='Д') or (otvet='д') then
       begin
        p:=filepos(f);
        seek(f,p-1);
        {writeln; }
         s_fio('фамилия: ',a.fio);
         prov_nom('номер группы :',a.ng);
         prov_opl('вид оплаты: ',a.opl);
            write('Результаты сдачи 5 зачетов: ') ;
                 for i:=1 to 5 do
                  begin
                   str(i,ts);
                   ts:='Зачет '+ ' '+ ts+ ' ';
                   prov_zac(ts, a.zac[i]);
                 end;
                  write('Результаты сдачи 3 экзаменов: ');
                    for j:=1 to 3 do
                     begin
                       str(j,ts);
                       ts:='Экзамен '+ ' '+ ts+' ';
                       prov_ecz(ts, a.ecz[j]);
                     end;


        write(f,a);
      end;
    end;
close(f);
{ close(ft); }
readln;

end;



procedure ovet_1;    {ответ на пункт меня 2.1}
var
k:byte;
s:string[3];
i,j:integer;
begin
cls(5);
assign(f,'C.dat');
rewrite(f);

writeln('СПИСОК ГРУППЫ С РЕЗУЛЬТАТАМИ СДАЧИ СЕССИИ');
writeln;

  prov_nom('ВВЕДИТЕ НОМЕР ГРУППЫ',a.ng);

       while not (eof(f)) do
       begin
          read(f,a);
          with a do

           if ng=151 then
                begin

                 write(ft,fio);
                writeln(fio);
          end          else if ng=152 then
           begin
            write(ft,fio);
            writeln(fio);
            end;
    close(f);

    end;
  end;

procedure Newbase;
   begin {Новая БД}
     rewrite(f);
     addmember;

   end;  {/Новая БД}

procedure menu_4;
begin
  cls(5);
  b:=2;
  menu[1,2]:='Cписок группы с результатами сесси               ';
  menu[2,2]:='Срдений балл по каждому предмету для студентов   ';
  menu[3,2]:='Общий балл группы                                ';
  menu[4,2]:='Графики изменения средних баллов                 ';
  menu[5,2]:='Круговая диаграмма процентного соотнтшения оценок';
  menu[6,2]:='Столбиковая диаграмма средних баллов             ';
  menu[7,2]:='Выход                                            ';
     kodv:=true;

      pk:=1;
  while kodv do
  begin

  ts:='ответы на запросы пользователя';
  WriteTx(9,15,XnCenter(ts),3,length(ts),ts);
  xn:=XnCenter(menu[1,2]);

  ts:='Выберите нужный пункт  и нажмите ENTER';
  WriteTx(4,15,XnCenter(ts),24,length(ts),ts);

  xmn:=length(menu[1,2]);
  ramka(6,10,xn,10,xmn,7);
  Vibor(b,kodv,pk,p_m);

  case p_m of
  1: ovet_1;
{ 2:
  3:
  4:
  5:
  6:}
  7: esc;
   end;
{  ch:=readkey;
  case ch of
  #27: begin

  end;}
end;
end;


{создание меню}
procedure menu_c;

begin
cls(5);
  b:=1;
  menu[1,1]:='Создать файла              ';
  menu[2,1]:='Дополнение файла           ';
  menu[3,1]:='Корректировка файла        ';
  menu[4,1]:='ответы запрос пользователя ';
  menu[5,1]:='выход                      ';
  kodv:=true;
  pk:=1;
  while kodv do
  begin
  cls(5);
    ts:='Меню';
    xn:=XnCenter(ts);
    lts:=length(ts);
    WriteTx(8,15,xn,5,lts,ts);
    ts:='Выберите нужный пункт меню и нажмите ENTER';
    WriteTx(4,15+blink,XnCenter(ts),24,length(ts),ts);
    ts:='Для возврата в основное окно нажмите ESC';
    WriteTx(4,15+blink,XnCenter(ts),25,length(ts),ts);
    xmn:=length(menu[1,1]);

    ramka(0,15,XnCenter(menu[1,1]),yn,xmn,5);
    Vibor(b,kodv,pk,p_m);

    case p_m of
      1:newbase;
      2:addmember;
      3: korrect;
      4: menu_4;
      5: ESC;

    end;
{    readln;}
  end;
end;
begin
assign(f,'С.dat');
  assign(ft,'С.txt');
  OrigMode:=LastMode;
  zastavka(ch);
  if ch = #13 then
   begin
     cls(3);
     menu_c;
  end;

  {finish;}
  textmode(origmode);
end.




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

Автор: volvo 20.04.2006 2:36

Ирин, это все, конечно прекрасно, но тут элементарно не хватает определений процедур... Что такое, например, Cls, или s_fio ?

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

Автор: Ирин 20.04.2006 2:50

Цитата(volvo @ 19.04.2006 23:36) *

Ирин, это все, конечно прекрасно, но тут элементарно не хватает определений процедур... Что такое, например, Cls, или s_fio ?

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


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

Автор: volvo 20.04.2006 3:03

Можно... Если только быть полностью уверенным, что их содержимое никак не влияет на работу всей программы. У тебя такая уверенность есть? У меня (при виде твоей тяги к использованию глобальных переменных везде, где только можно) такой уверенности почему-то нет.

Ладно. попробую закомментировать их и проверить...


P.S.
Ну, нет, так не пойдет... Что, все процедуры убирать, а все недостающие переменные (а их по крайней мере десяток) описывать заново? Извини, но это тебе нужно, насколько я понимаю. Не хочешь приводить полную программу, которую можно БЕЗ ИЗМЕНЕНИЙ откомпилировать - ищи ошибки сама. Возможно у тебя в неверном описании переменных и заключается ошибка...

Кстати, один End в процедуре correct все-таки пропущен, так что я вообще не понимаю, как ЭТА программа у тебя компилировалась.