Версия для печати темы
Нажмите сюда для просмотра этой темы в обычном формате
Форум «Всё о Паскале» _ Задачи _ работа с файлом
Автор: Renbo 13.03.2007 3:46
USES CRT,Printer;
VAR
name:text;
procedure sozdanie;
VAR
s:integer;
push:char;
i:integer;
Begin
assign(name,'test.txt');
rewrite(name);
repeat
writeln('введите данные в фаил:');
write('код отдела - '); readln(s); writeln(name,s);
write('код лаборатории - '); readln(s); writeln(name,s);
write('табельный номер сотрудника - '); readln(s); writeln(name,s);
write('дата(месяц) - '); readln(s); writeln(name,s);
write('код начисления - '); readln(s); writeln(name,s);
write('сумма начисления - '); readln(s); writeln(name,s);
writeln('Хотите ли сделать ещё запись?(Y/N)');
push:=readkey;
until push in ['N','n'];
close(name);
End;
procedure correctirovka;
Var
s:String;
push,otvet:char;
Begin
assign(name,'test.txt');
reset(name);
while not eof(name) do
begin
readln(name,s);
writeln(s);
end;
writeln('Хотите ли вы добавить запись к файлу(Y/N) ?');
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;
IF otvet in ['Y','y'] then
begin
append(name);
writeln('Добавление записи:');
repeat
write('код отдела - '); readln(s); writeln(name,s);
write('код лаборатории - '); readln(s); writeln(name,s);
write('табельный номер сотрудника - '); readln(s); writeln(name,s);
write('дата(месяц) - '); readln(s); writeln(name,s);
write('код начисления - '); readln(s); writeln(name,s);
write('сумма начисления - '); readln(s); writeln(name,s);
writeln('Хотите ли добавить ещё одну запись?(Y/N)');
push:=readkey;
until push in ['N','n'];
close(name);
IF otvet in ['N','n'] then
begin
writeln('Хотите ли удалить запись(Y/N) ?');
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;
end;
End;
procedure prosmotr;
VAR
s:string;
i:integer;
Begin
i:=0;
assign(name,'test.txt');
reset(name);
writeln('--------------------------------------------------------------------');
writeln('№':5,' Код Код Табельный Дата Код Сумма ');
writeln(' отдела лаборатории номер (месяц) Начисления Начисления');
writeln('--------------------------------------------------------------------');
while not eof(name) do
begin
inc(i);
write(i:5);
readln(name,s); write(s:7);
readln(name,s); write(s:11);
readln(name,s); write(s:11);
readln(name,s); write(s:9);
readln(name,s); write(s:9);
readln(name,s); write(s:12);
end;
readln;
close(name);
End;
procedure pechatnaprintere;
Begin
writeln(LST,'test.txt');
End;
procedure podmenu1;
VAR
F:integer;
ch:char;
begin
repeat
F:=0;
clrscr;
writeln(' Ведение основного файла: ');
writeln('1 -> Создание нового основного файла');
writeln('2 -> Корректировка основного файла');
writeln('3 -> Просмотр на экране основного файла');
writeln('4 -> Печать основного файла');
writeln('5 -> Возврат в главное меню');
repeat
ch:=readkey;
IF not(ch in ['1'..'5']) 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'..'5']) or (F=4);
case ch of
'1': sozdanie;
'2': correctirovka;
'3': prosmotr;
'4': pechatnaprintere
end;
until (F=4) or (ch='5');
end;
Begin
podmenu1;
End.
запутался с procedure prosmotr. Если я создаю несколько записей, то они должны грмотно выводиться по столбцам. А выходит, что всё сбивается и белеберда.... (
Если ещё что-то корявое, то поправьте плизз
Автор: volvo 13.03.2007 3:54
while not eof(name) doрешит твою проблему...
begin
inc(i);
write(i:5);
readln(name,s); write(s:7);
readln(name,s); write(s:11);
readln(name,s); write(s:11);
readln(name,s); write(s:9);
readln(name,s); write(s:9);
readln(name,s); writeLN(s:12); { <--- !!! }
end;
Автор: Renbo 13.03.2007 4:08
спасиб большое) Я чувствовал, что там что-то мелкое такое)
А не поглядишь, чего она не хочит компилится, просто там осталось корректировку дописать, вот сижу пишу, а она что-то отказывается компилиться....а удалив часть кода в процедуре керректировки всё заработало нормально...
Автор: volvo 13.03.2007 4:13
У тебя один End был пропущен...
procedure correctirovka;
Var
s:String;
push,otvet:char;
Begin
assign(name,'test.txt');
reset(name);
while not eof(name) do
begin
readln(name,s);
writeln(s);
end;
writeln('Хотите ли вы добавить запись к файлу(Y/N) ?');
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;
IF otvet in ['Y','y'] then
begin
append(name);
writeln('Добавление записи:');
repeat
{ ... }
until push in ['N','n'];
close(name);
end; { <--- Вот этого End не хватает !!! }
...
Автор: Renbo 13.03.2007 4:44
IF otvet in ['Y','y'] then
begin
append(name);
writeln('Добавление записи:');
repeat
write('код отдела - '); readln(s); writeln(name,s);
write('код лаборатории - '); readln(s); writeln(name,s);
write('табельный номер сотрудника - '); readln(s); writeln(name,s);
write('дата(месяц) - '); readln(s); writeln(name,s);
write('код начисления - '); readln(s); writeln(name,s);
write('сумма начисления - '); readln(s); writeln(name,s);
writeln('Хотите ли добавить ещё одну запись?(Y/N)');
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;
until otvet in ['Y','y'];
end;
вот я так подправил код в процедуре всё той же, а он мне из цикла главного не выходит...я что-то ваще уже ничего не понимаю...полюбому мелоч какая-то где-то...
Не подскажешь?
Автор: samec 13.03.2007 15:03
IF otvet in ['Y','y'] then
begin
append(name);
writeln('Добавление записи:');
repeat
write('код отдела - '); readln(s); writeln(name,s);
write('код лаборатории - '); readln(s); writeln(name,s);
write('табельный номер сотрудника - '); readln(s); writeln(name,s);
write('дата(месяц) - '); readln(s); writeln(name,s);
write('код начисления - '); readln(s); writeln(name,s);
write('сумма начисления - '); readln(s); writeln(name,s);
writeln('Хотите ли добавить ещё одну запись?(Y/N)');
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;
until otvet in ['N','n']; {исправить тут}
close(name); {и, по-моему, добавить вот тут}
end;