Помощь - Поиск - Пользователи - Календарь
Полная версия: Косяк с выводом
Форум «Всё о Паскале» > Pascal, Object Pascal > Задачи
Renbo
Вообщем всё пашет зашибись, только вот возник вдруг косяк с выводом на экран. Косяк возникает где-то при создании, так как я пробывал в файле вручную писать строчки и он выводил нормально.
Проблема: после считывания 2х строчек, он автоматически увеличивает i , которая показывает номер записи. 1 запись = 4 строчки.


USES CRT,Printer;

VAR
spravochnik1:text;

function FileExist:boolean;
Begin
{$I-}
assign(spravochnik1,'spravka1.txt');
reset(spravochnik1);
close(spravochnik1);
{$I+}
FileExist:=(IOResult=0);
End;


function get_str(max_len:byte):string;
var
s:string;
pb:char;
begin
s:='';
repeat
pb := readkey;
{ If (pb in [#48..#57,#8]) then }
if length(s) <= max_len then
case pb of
#8: begin
if length(s) > 0 then
begin
write(#8,#32,#8);
delete(s,length(s),1)
end
end
else
if length(s) <> max_len then
begin
s:=s+pb;
write(pb)
end
end
until pb=#13;
writeln;
get_str:=s
end;


procedure vivod;
var
i:integer;
s:string;
Begin
i:=0;
assign(spravochnik1,'spravka1.txt');
reset(spravochnik1);
writeln('--------------------------------------------------------------------');
writeln('№':4,' Код Название ФИО заведующего Телефон');
writeln(' отдела отдела отделом ');
writeln('--------------------------------------------------------------------');
while not eof(spravochnik1) do
begin
inc(i);
write(i:2);
readln(spravochnik1,s); write(s:9);
readln(spravochnik1,s); write(s:7);
readln(spravochnik1,s); write(s);
readln(spravochnik1,s); writeln(s);
end;
close(spravochnik1);
End;

function DaNet:char;
var push,otvet:char;
begin
otvet:='n';
write(otvet);
repeat
push:=readkey;
gotoxy(wherex-1,wherey);
IF push in ['Y','y','n','N'] then otvet:=push;
write(otvet);
until ord(push)=13;
writeln;
danet:=otvet;
end;

procedure sozdanie;
VAR
s:string;
push,otvet:char;
Begin
clrscr;
If FileExist=true then
begin
writeln('Фаил уже существует');
writeln('Создание нового файла приведёт к удалению старого');
writeln('Желаете ли вы создать новый фаил(Y/N)?');
otvet:=DaNet;
IF otvet in ['Y','y'] then
begin
assign(spravochnik1,'spravka1.txt');
rewrite(spravochnik1);
repeat
writeln('введите данные:');
write('код отдела - '); s:=get_str(5); writeln(spravochnik1,s);
write('Название отдела - '); s:=get_str(8); writeln(spravochnik1,s);
write('ФИО зав. отделом - '); s:=get_str(10); writeln(spravochnik1,s);
write('служебный телефон - '); s:=get_str(7); writeln(spravochnik1,s);
writeln('Хотите ли сделать ещё запись?(Y/N)');
otvet:=DaNet;
until otvet in ['N','n'];
close(spravochnik1);
end
end
Else
begin
assign(spravochnik1,'spravka1.txt');
rewrite(spravochnik1);
repeat
writeln('введите данные:');
write('код отдела - '); s:=get_str(5); writeln(spravochnik1,s);
write('Название отдела - '); s:=get_str(5); writeln(spravochnik1,s);
write('ФИО зав. отделом - '); s:=get_str(5); writeln(spravochnik1,s);
write('служебный телефон - '); s:=get_str(5); writeln(spravochnik1,s);
writeln('Хотите ли сделать ещё запись?(Y/N)');
otvet:=DaNet;
until otvet in ['N','n'];
close(spravochnik1);
end;
End;

procedure prosmotr;
VAR
s:string;
i:integer;
Begin
If FileExist=False then
begin
writeln('Создайте сперва фаил!!!');
readkey;
exit;
end;
clrscr;
vivod;
readkey;
End;


procedure podmenu1;
VAR
F:integer;
ch:char;
begin
repeat
F:=0;
clrscr;
writeln(' Ведение основного файла: ');
writeln('1 -> Создание нового основного файла');
writeln('2 -> Просмотр на экране основного файла');
writeln('3 -> Возврат в главное меню');
repeat
ch:=readkey;
IF not(ch in ['1'..'3']) then
begin
writeln('неверная клавиша!');
F:=F+1;
if F=4 then
begin
writeln('программа завершена из-за неправильного ввода данных');
writeln('нажмите любую кнопку для выхода');
readkey;
end
else
if F=3 then
begin
writeln('у вас ещё ', 4-F,' попытка');
writeln('выберите существующий пункт подменю');
end
else
begin
writeln('у вас ещё ', 4-F,' попытки');
writeln('выберите существующий пункт подменю');
end;
end;
until (ch in ['1'..'3']) or (F=4);
case ch of
'1': sozdanie;
'2': prosmotr;
end;
until (F=4) or (ch='3');
end;


Begin
podmenu1;
End.


volvo
Цитата
Косяк возникает где-то при создании
Именно...
get_str надо чуть подправить - добавить обработку #13, а вернее сделать так, чтобы этот символ не добавлялся в строку:

function get_str(max_len:byte):string;
var
s:string;
pb:char;
begin
s:='';
repeat
pb := readkey;
if length(s) <= max_len then
case pb of
#8: begin
if length(s) > 0 then
begin
write(#8,#32,#8);
delete(s,length(s),1)
end
end;
#13:; { <--- Вот оно !!! }
else
if length(s) <> max_len then
begin
s:=s+pb;
write(pb)
end
end
until pb=#13;
writeln;
get_str:=s
end;
Просто я своей реализацией пользовался немного по-другому, поэтому было не столь критично...
Renbo
Спасиб большое )
Это текстовая версия — только основной контент. Для просмотра полной версии этой страницы, пожалуйста, нажмите сюда.