В процедуре неправильно выводится результат - Turbo Pascal

Узнай цену своей работы

Формулировка задачи:

Процедура должна выводить сумму при вводе номера, но кроме суммы выводит еще что такого номера нет:
не знаю как исправить, помогите пожалуйста!

Решение задачи: «В процедуре неправильно выводится результат»

textual
Листинг программы
program pp;
uses crt;
     type
                schet=record
                plat:string[30];
                poluch:string[30];
                summ:integer;
                end;
   var
        f:file of schet;
        sh:schet;
        i,err: integer;
        s:string;
procedure prover;
          begin
          val(s,i,err);
          if err<>0 then   writeln('Введите число ');
          end;
procedure ncreate;
  var ioresult:integer;
   begin
         assign(f,'data');
         {$I-}
         reset(f);
         {$i+}
         If IOresult=0  then
         exit
         else
         rewrite(f);
   end;
procedure print;
 var
  j:integer;
       begin
          if (i<=0) or (i>filesize(f)) then
          exit;
          seek(f,i-1);
          read(f,sh);
          writeln;
          writeln('Номер записи ',i);
          writeln('Расчетный счет плательщика ',sh.plat);
          writeln('Расчетный счет получателя ',sh.poluch);
          write('Перечисляемая сумма в руб. ',sh.summ);
          writeln;
       end;
procedure add;
  var
        er:integer;
        c,j:byte;
          begin
               seek(f,filesize(f));
               writeln('Введите счет плательщика');
               readln(sh.plat);
               writeln('Введите счет получателя');
               read(sh.poluch);
             repeat
               writeln('Введите перечисляемую сумму в руб');
               readln(s);
               val(s,sh.summ,er);
                if er<>0
                 then writeln( 'Тут следует ввести число');
             until er=0;
               write(f,sh);
               writeln('Запись успешно добавлена. Спасибо!');
          end;
procedure saw;
var z,x,y:byte;
ch:char;
   begin
     clrscr;
     window(1,21,80,24);
     writeln('Управление стрелочками: вверх-в начало файла, вниз-в конец файла');
     writeln('ESC- выход из просмотра');
     window(1,1,80,20);
     if filesize(F)=0 then writeln('Ваш файл пуст');
     I:=1;
     repeat
        begin
          ch:=readkey;
          if (ch=#80) and (i<=filesize(f)+1)  then
            begin
             if (z=2) then
                  begin
                   i:=2;
                   z:=0;
                  end;
             print;
             inc(i);
             if i>filesize(f)+1  then
                begin
                 x:=whereX;
                 y:=whereY;
                 window(1,24,80,25);
                 writeln('Конец файла достигнут, для выхода нажмите ESC');
                 I:=filesize(f)+1;
                 window(1,1,80,20);
                 gotoXY(x,y);
                 Z:=1;
                end;
           if (i<>(filesize(f)+1)) then
                    begin
                     print;
                     inc(i);
                    end;
            end;
            end;
       if   (ch=#72) then
       begin
       if   i>=filesize(f) then
                begin
                I:=filesize(f)-1;
                end;
           print;
           dec(i);
       if  I<=0 then
            begin
               x:=whereX;
               y:=whereY;
               window(1,24,80,25);
               writeln('Начало файла, для выхода нажмите ESC ');
               z:=2;
               I:=0;
               window(1,1,80,20);
               gotoXY(x,y);
             end;
      if i<>0 then
        begin
          print;
          dec(i);
        end;
      end;
        until ch=#27;
         window(1,1,80,25);
         clrscr;
   end;
procedure saw_one;
   begin
      writeln('Номер записи которую хотите посмотреть');
      repeat
      readln(s);
      prover;
      until err=0;
      if ((filesize(f)+1)>I) and (I>0)
      then print
      else writeln('Записи под таким номером не существует');
    end;
procedure correct;
          var j:integer;
          c:byte;
          ys:char;
  begin
      J:=1;
      saw_one;
      if err=0
      then
        begin
         if (i>filesize(f)) or (I<=0)   then exit;
         seek(f,i-1);
         read(f,sh);
         seek(f,i-1);
         writeln('Вы  хотите изменить расчетный счет плательщика? Y-да, все остальные буквы нет.');
         readln(ys);
         if (ys='y') or (ys='Y') then
                        begin
                         writeln('Введите новый расчетный счет плательщика');
                         readln(sh.plat);
                        end;
          writeln('Хотите изменить расчетный счет получателя? Y-да, нет-все остальные буквы');
          readln(ys);
          if (ys='y') or (ys='Y') then
                        begin
                         writeln('Введите новый расчетный счет получателя.');
                         readln(sh.poluch);
                        end;
                writeln('Хотите изменить перечисляемую сумму? Y-да, нет- все остальные буквы.');
                readln(ys);
                if (ys='y') or (ys='Y') then
             begin
                  repeat
                  writeln('Введите новую перечисляемую сумму в руб.');
                  readln(s);
                  prover;
                  until err=0;
                  sh.summ:=i;
             end;
   end;
    write(f,sh);
     writeln('Запись успешно сохранена. Спасибо!');
     end;
procedure del;
  begin
     writeln('Введите номер удаляемой записи.');
     readln(s);
     prover;
     if err<> 0 then exit;
     if i<=0 then
        begin
                writeln('Записи считают, начиная с 1ой.');
                exit;
        end;
     if filesize(f)<i then
      begin
        writeln('Этой записи еще не существует.');
        exit;
      end;
     if (filesize(f)=0) then writeln('В вашем файле не осталось записей');
     if (filesize(f)=1) and (i=1) then
        begin
                rewrite(f);
                writeln('Вы удалили все записи из файла ');
                exit;
        end;
     if Filesize(f)=i then
        begin
               seek(f,filesize(f)-1);
               truncate(f);
               exit;
        end;
         begin
          for i:=i to filesize(f)-1 do
           begin
              seek(f,i);
              read(f,sh);
              seek(f,i-1);
              write(f,sh);
           end;
          seek(f,filesize(f)-1);
          truncate(f);
         end;
   end;
procedure output;
          var
          nom:string;
          x:integer;
          begin
          reset(f);
          x:=0;
               writeln('Введите расчетный счет плательщика');
               readln(nom);
               while not eof(f) do
               begin
               read(f,sh);
               if nom=sh.plat then begin
               writeln('Сумма снятая с расчетного счета плательщика ',sh.summ); x:=1; end;
 
               end;
               if x=0 then writeln('Такого расчетного счета нет');
               end;
procedure sort;
var
 sh1,sh2:schet;
 j:integer;
    begin
    seek(f,0);
        for i:=1 to filesize(f) do
                for j:=0 to filesize (f)-2 do
                 begin
                        seek(f,j);
                        read(f,sh1);
                        seek(f,j+1);
                        read(f,sh2);
                        if sh1.plat>sh2.plat then
                                begin
                                        seek(f,j+1);
                                        write(f,sh1);
                                        seek(f,j);
                                        write(f,sh2);
                 end;           end;
        writeln('сортировка выполнена');
    end;
procedure rewr;
var
ys:string;
        begin
                        writeln('Это действие удалит все существующие записи');
                        writeln('Вы уверены?');
                        writeln('Y-да, все остальные буквы-нет');
                        readln(ys);
                        if (ys='y') or (ys='Y') then
                                begin
                                  rewrite(f);
                                  writeln('Новый файл создан успешно');
                                end
                        else writeln('Удаление отменено');
        end;
begin
ncreate;
clrscr;
     repeat
     I:=0;
     writeln('нажмите ENTER для возврата в главное меню ');
     readln;
     clrscr;
     writeln('                        ГЛАВНОЕ МЕНЮ   ');
     writeln('1. Создание нового файла(УДАЛИТ ВСЕ СУЩЕСТВУЮЩИЕ ЗАПИСИ)');
     writeln('2. Добавление записи');
     writeln('3. Просмотр всех записей');
     writeln('4. Просмотр одной записи по ее номеру');
     writeln('5. Корректировка записи');
     writeln('6. Удаление записи по введеному номеру ');
     writeln('7. Показать сумму, снятую с расчетного счета плательщика');
     writeln('8. Сортировка по алфавиту');
     writeln('9. Выход из программы');
     readln(s);
       prover;
       if err=0 then
    begin
       case i of
            1: rewr;
            2:add;
            3:saw;
            4:saw_one;
            5:correct;
            6:del;
            7:output;
            8:sort;
            9:halt;
      end;
 
      if (I<0) or (I>9) then  writeln('Такой процедуры не существует');
    end;
        until i=9;
        close(f);
end.

ИИ поможет Вам:


  • решить любую задачу по программированию
  • объяснить код
  • расставить комментарии в коде
  • и т.д
Попробуйте бесплатно

Оцени полезность:

10   голосов , оценка 4 из 5
Похожие ответы