if l=2 then
begin
Очистка экрана
clrscr;
Установка цвета фона и символов и вывод на экран сообщения
textbackground(14);textcolor(15);
writeln('Вы действительно хотите создать новые записи?');
writeln('!!!ПРЕДЫДУЩИЕ ЗАПИСИ БУДУТ УТЕРЯНЫ!!!');
textbackground(0);
gotoxy(1,4);
writeln('Для продолжения нажмите или -возврат в
главное меню.');
Считывание клавиши с клавиатуры
c:=readkey;
Если нажата клавиша , то выполняется возврат к главному меню и переход
к метки menu2
if c=#27 then begin menu; goto menu2 end
Иначе идет ввод переменной q – количество создаваемых записей
else
writeln('Введите количество записей:');
read(q);
Подготовка файла к записи
rewrite(f);
Цикл ввода новых записей. Выход из цикла осуществиться в том случае, когда
a.n будет равно q
repeat
writeln('введи текущий номер продукции...'); readln(a.n);
writeln('введи переходящий остаток продукции на начало года...');
readln(a.e1);
writeln('введи приход продукции...'); readln(a.e2);
writeln('введи расход...');readln(a.e3);
writeln('введи цену за 1 шт...');readln(a.e4);
write(f,a);
until (a.n=q);
Очистка экрана и вывод сообщения
writeln('ВСЁ OK.');
Задержка программы. Возврат в главное меню и переход к метки menu2
delay(1000);
menu; goto menu2;
Завершение составного оператора begin…end
end;
end
Если переменная l не равна 1 и 2, а равна 3, то выполняется алгоритм
добавления записи
if l=3 then
Очистка экрана, установка цвета фона и символов и вывод сообщения
textcolor(15);
writeln('Продолжить? (y/n)');
Если нажата любая клавиша, кроме , то выполняется возврат к главному
меню и переход к метки menu2
if c<>#121 then begin menu;goto menu2; end
Иначе выполняется алгоритм добавления новой записи
очистка экрана
Ввод количества добовляемых записей -mm
writeln('Введите количество добовляемых записей:');
read(mm);
Подготовка файла к чтению, определения конца файла и установка указателя в
конец файла
reset(f); n:=filesize(f); seek(f,n);
установка номера добовляемой записи
pp:=n+1;
Цикл добавления записи. Завершится тогда, когда номер последней добавляемой
записи qq будет равен mm
writeln('введи текущий номер продукции...');readln(qq); a.n:=pp;
pp:=pp+1;
until (qq=mm);
Задержка программы
Возврат в главное меню и переход к метки menu2
Если l не равно 1, не 2 и не 3, а равно 4, то выполняется алгоритм
удаления записей
if l=4 then
Установка текстового экрана для вывода таблицы с помощью процедуры view
window(1,1,68,22);
view(17);
Установка текстового экрана для управления удаления записей
window(64,1,80,22);
Установка цвета символов и вывод сообщения
Если нажата любая клавиша, кроме , то выполняется возврат к стандартному
текстовому режиму, к главному меню и переход к метки menu2
if c<>#121 then begin textmode(Co80); menu; goto menu2; end
Иначе происходит ввод удаляемой записи - nn
write('Введи номер:');
readln(nn);
Если вводимого номера записи не существует – выполняется процедура вывода
сообщения об ошибке – error, и переход к метки menu2
if nn>filesize(f) then begin error; goto menu2; end;
Удаление записи: запись в новый файл:
Подготовка файла к чтению
reset(f);
Установка связь с новым файлом
assign (f2,'k2');
Подготовка нового файла к записи
rewrite(f2);
Обнуление переменных, необходимых для удаления записи
l:=0;q:=0;
Определение количества записей в первоначальном файле
n:=filesize(f);
Цикл перезаписи записей из первого файла в новый, при этом удаляемая запись
игнорируется. Цикл завершается, когда все записи будут переписаны
l:=l+1;
if l<>nn then
q:=q+1;
seek(f,l-1);
read(f,a);
b.n:=q; b.e1:=a.e1; b.e2:=a.e2; b.e3:=a.e3; b.e4:=a.e4;
write(f2,b);
until l=n;
Подготовка только что созданного файла к чтению.
reset(f2);
Подготовка первоначального файла к перезаписи
Цикл перезаписи из только что созданного файла записей в первоначальный, но
уже без требуемой записи. Перезапись будет производиться, пока не конец
второго файла
read(f2,b);
a.n:=b.n; a.e1:=b.e1; a.e2:=b.e2; a.e3:=b.e3; a.e4:=b.e4;
until eof(f2);
Вывод сообщения и задержка программы
writeln;
writeln('Всё Ok!');
Вывод сообщения о возможности продолжения удаления новых записей или
возврата к главному меню
writeln('Reload-');
write('Exit-');
Если нажата клавиши , то происходит возврат к главному меню и переход
if c=#27 then begin menu; goto menu2; end
иначе устанавливается стандартный текстовой режим, l присваивается 4 и
осуществляется переход к метке menu2, т.е. происходит опять алгоритм
удаления записи
else begin textmode(Co80); l:=4; goto menu2; end;
Завершение составных операторов begin…end
Если l не равно 1, не 2 и не 3, и не 4, а равно 5, то выполняется алгоритм
редактирования записей
if l=5 then
Выполняется процедура вывода таблицы
view(27);
if c<>#121 then begin textmode(Co80); menu;goto menu2; end
Иначе происходит ввод номера записи для редактирования - nn
write('Введите номер для редактирования:'); read(nn);
Очистка экрана и установка переменной i, для предварительного просмотра
записи
i:=27;
Подготовка файла к чтению и записи и установка указателя на нужной
редактируемой записи
reset(f); seek(f,nn-1);
Считывание и вывод на экран редактируемой записи для предварительного
просмотра
st:=((a.e1+a.e2)-a.e3)*a.e4;
gotoXY(i-15,1);write(a.n);
gotoXY(i-5,1);write(a.e1);
gotoxy(i+11,1);write(a.e2);
gotoxy(i+20,1);write(a.e3);
gotoxy(i+29,1);write(a.e4:4:2);
gotoxy(i+37,1);write(st:4:2);
gotoxy(7,2);
Установка указателя на необходимой записи, т.к. после вывода на экран
указатель сдвинулся
seek(f,nn-1);
Вывод сообщений о подтверждении редактирования каждого компонента
редактируемой записи.
Если при этом будет нажата , то выполняется перезапись компонента
записи, путем ввода новой (nn) и присваивание ее –старой (a.e1…a.e4).
Если при выводе сообщения будет нажата любая клавиши, кроме , то
выполняется переход к редактированию следующего компонента данной записи.
writeln('Изменить переходящий остаток продукции на начало года?
(y/n)');
if c=#121 then begin write('Вводим новое:');read(nn); a.e1:=nn; end;
writeln('Изменить приход продукции? (y/n)');c:=readkey;
if c=#121 then begin write('Вводим новое:'); read(nn);a.e2:=nn; end;
writeln('Изменить расход? (y/n)');c:=readkey;
if c=#121 then begin write('Вводим новое:'); read(nn);a.e3:=nn; end;
writeln('Изменить цену за 1 шт? (y/n)');c:=readkey;
if c=#121 then begin write('Вводим новое:'); read(o);a.e4:=o; end;
Вывод сообщение и задержка программы
writeln; write('Все Ok'); delay(1000);
Очистка экрана, возврат к главному меню и переход к метке menu2
clrscr; menu;
goto menu2;
Если l не равно 1, не 2 и не 3, и не 4, и не 5, а равно 6, то выполняется
Страницы: 1, 2, 3, 4, 5, 6
