В процедуре неправильно выводится результат - 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.
ИИ поможет Вам:
- решить любую задачу по программированию
- объяснить код
- расставить комментарии в коде
- и т.д