Обработка экономической информации средствами языка Pascal
переменной .
{-----------krugi------------}
for i:=0 to 399 do
begin
setcolor(red);
circle(200,100,i);
setcolor(green);
circle(400,100,i);
setcolor(yellow);
circle(300,300,i);
delay(10);
end;
Вывод на экран окружности, уменьшающей свой радиус.
for i:=399 downto 0 do
begin
setcolor(i);
сircle(322,250,i);
delay(10);
end;
{----------end_krugi---------}
Закрытие граф. режима
closegraph;
Завершение составного оператора begin…end
end;
Завершение процедуры вывода заставки
end;
Процедура вывода сообщения об ошибке – error:
begin
Обнуление счетчика
i:=0;
Цикл вывода сообщения об ошибке, пока i не равно 5
repeat
textmode(Co80);
clrscr;
gotoxy(24,8);textcolor(15);
write('ВЫ ВВЕЛИ НЕПРАВИЛЬНЫЙ НОМЕР');
звук, при выводе сообщения
sound(185);delay(100);nosound;
clrscr;
gotoxy(24,8);textcolor(7);
write('ВЫ ВВЕЛИ НЕПРАВИЛЬНЫЙ НОМЕР');
sound(174);delay(100);nosound;
наращивание счетчика
i:=i+1;
until i=5;
Отключение звука
nosound;
Возврат в главное меню
menu;
Завершение процедуры вывода сообщения об ошибке
end;
Процедура выхода из программы – exitt:
Очитстка экрана
clrscr;
Инициализация графики
initgraph(gd,gm,'bgi');
Вывод текста на экран пока не нажата какая-нибудь клавиша
repeat
settextstyle(7,0,4);setcolor(15);
outtextxy(90,getmaxy div 4, 'Technical support by e-mail:');
settextstyle(1,0,4);setcolor(10);
outtextxy(120,(getmaxy div 4)+50, 'support@sorgepro.agava.ru');
settextstyle(7,0,4);setcolor(15);
outtextxy(140,(getmaxy div 4)+100, 'or visited our web site:');
settextstyle(1,0,4);setcolor(10);
outtextxy(120,(getmaxy div 4)+150, 'http://sorgepro.agava.ru');
settextstyle(2,0,5);setcolor(15);
outtextxy(getmaxx div 4,getmaxy-30,'(c)2000."Sorge pro".All rights
don''t reserved.');
until keypressed;
Закрытие граф. режима
closegraph;
Выход из программы
exit;
Завершение процедуры
end;
{==========================Proga===========================}
Идет выполнение процедуры Zast:
при нажатие какой-либо другой клавиши – устанавливается связь с файлом
assign (f,’'путь к файлу ’)
Установка стандартного текстового режима
textmode(Co80);
Печать главного меню, используя процедуру menu
Установка метки
menu2:
Если l=1, то выполняется печать таблицы
if l=1 then
begin
Печать таблицы с помощью процедуры view, где w=27;
Вывод сообщения для пользователя после вывода таблицы
textcolor(15);
gotoxy(7, ww+1);
writeln('Для выхода нажмите или -возврат в главное
меню. ');
Считывание нажатия клавиши с клавиатуры
c:=readkey;
Установка стандартного текстового режима
textmode(Co80);
Если нажата клавиша происходит возврат в главное меню: выполнение
процедуры menu и переход к метки menu2
if c=#27 then begin menu; goto menu2 end
Иначе выполняется процедура выхода – exitt
else begin exitt;
Завершение составного оператора begin…end
end
Если l не равно 1, а равно 2 то выполняется алгоритм создания записей
заново
else
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
begin
writeln('Введите количество записей:');
read(q);
Очистка экрана
clrscr;
Подготовка файла к записи
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);
Очистка экрана и вывод сообщения
clrscr;
writeln('ВСЁ OK.');
Задержка программы. Возврат в главное меню и переход к метки menu2
delay(1000);
menu; goto menu2;
Завершение составного оператора begin…end
end;
Завершение составного оператора begin…end
end
Если переменная l не равна 1 и 2, а равна 3, то выполняется алгоритм
добавления записи
else
if l=3 then
begin
Очистка экрана, установка цвета фона и символов и вывод сообщения
clrscr;
textbackground(0);
textcolor(15);
writeln('Продолжить? (y/n)');
Считывание клавиши с клавиатуры
c:=readkey;
Если нажата любая клавиша, кроме , то выполняется возврат к главному
меню и переход к метки menu2
if c<>#121 then begin menu;goto menu2; end
Иначе выполняется алгоритм добавления новой записи
else
begin
очистка экрана
clrscr;
Ввод количества добовляемых записей -mm
writeln('Введите количество добовляемых записей:');
read(mm);
очистка экрана
clrscr;
Подготовка файла к чтению, определения конца файла и установка указателя в
конец файла
reset(f); n:=filesize(f); seek(f,n);
установка номера добовляемой записи
pp:=n+1;
Цикл добавления записи. Завершится тогда, когда номер последней добавляемой
записи qq будет равен mm
repeat
writeln('введи текущий номер продукции...');readln(qq); a.n:=pp;
writeln('введи переходящий остаток продукции на начало года...');
readln(a.e1);
writeln('введи приход продукции...'); readln(a.e2);
writeln('введи расход...');readln(a.e3);
writeln('введи цену за 1 шт...');readln(a.e4);
write(f,a);
pp:=pp+1;
until (qq=mm);
Очистка экрана и вывод сообщения
clrscr;
writeln('ВСЁ OK.');
Задержка программы
delay(1000);
Возврат в главное меню и переход к метки menu2
menu; goto menu2;
Завершение составного оператора begin…end
end;
Завершение составного оператора begin…end
end
else
Если l не равно 1, не 2 и не 3, а равно 4, то выполняется алгоритм
удаления записей
if l=4 then
begin
Очистка экрана
clrscr;
Установка текстового экрана для вывода таблицы с помощью процедуры view
window(1,1,68,22);
view(17);
Установка текстового экрана для управления удаления записей
window(64,1,80,22);
Установка цвета символов и вывод сообщения
textcolor(15);
writeln('Продолжить? (y/n)');
Считывание клавиши с клавиатуры
c:=readkey;
Если нажата любая клавиша, кроме , то выполняется возврат к стандартному
текстовому режиму, к главному меню и переход к метки menu2
if c<>#121 then begin textmode(Co80); menu; goto menu2; end
Иначе происходит ввод удаляемой записи - nn
else
begin
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);
Цикл перезаписи записей из первого файла в новый, при этом удаляемая запись
игнорируется. Цикл завершается, когда все записи будут переписаны
repeat
l:=l+1;
if l<>nn then
begin
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);
end;
until l=n;
Подготовка только что созданного файла к чтению.
reset(f2);
Подготовка первоначального файла к перезаписи
rewrite(f);
Цикл перезаписи из только что созданного файла записей в первоначальный, но
уже без требуемой записи. Перезапись будет производиться, пока не конец
второго файла
repeat
read(f2,b);
a.n:=b.n; a.e1:=b.e1; a.e2:=b.e2; a.e3:=b.e3; a.e4:=b.e4;
write(f,a);
until eof(f2);
Вывод сообщения и задержка программы
writeln;
writeln('Всё Ok!');
delay(1000);
Вывод сообщения о возможности продолжения удаления новых записей или
возврата к главному меню
writeln('Reload-');
write('Exit-');
Считывание клавиши с клавиатуры
c:=readkey;
Если нажата клавиши , то происходит возврат к главному меню и переход
к метки menu2
if c=#27 then begin menu; goto menu2; end
иначе устанавливается стандартный текстовой режим, l присваивается 4 и
осуществляется переход к метке menu2, т.е. происходит опять алгоритм
удаления записи
else begin textmode(Co80); l:=4; goto menu2; end;
Завершение составных операторов begin…end
end;
end
Если l не равно 1, не 2 и не 3, и не 4, а равно 5, то выполняется алгоритм
редактирования записей
else
if l=5 then
begin
Выполняется процедура вывода таблицы
view(27);
Установка цвета символов и вывод сообщения
textcolor(15);
writeln('Продолжить? (y/n)');
Считывание клавиши с клавиатуры
c:=readkey;
Если нажата любая клавиша, кроме , то выполняется возврат к стандартному
текстовому режиму, к главному меню и переход к метки menu2
if c<>#121 then begin textmode(Co80); menu;goto menu2; end
Иначе происходит ввод номера записи для редактирования - nn
else
begin
write('Введите номер для редактирования:'); read(nn);
Если вводимого номера записи не существует – выполняется процедура вывода
сообщения об ошибке – error, и переход к метки menu2
if nn>filesize(f) then begin error; goto menu2; end;
Очистка экрана и установка переменной i, для предварительного просмотра
записи
clrscr;
i:=27;
Подготовка файла к чтению и записи и установка указателя на нужной
редактируемой записи
reset(f); seek(f,nn-1);
Считывание и вывод на экран редактируемой записи для предварительного
просмотра
read(f,a);
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)');
c:=readkey;
if c=#121 then begin write('Вводим новое:');read(nn); a.e1:=nn; end;
writeln;
writeln('Изменить приход продукции? (y/n)');c:=readkey;
if c=#121 then begin write('Вводим новое:'); read(nn);a.e2:=nn; end;
writeln;
writeln('Изменить расход? (y/n)');c:=readkey;
if c=#121 then begin write('Вводим новое:'); read(nn);a.e3:=nn; end;
writeln;
writeln('Изменить цену за 1 шт? (y/n)');c:=readkey;
if c=#121 then begin write('Вводим новое:'); read(o);a.e4:=o; end;
write(f,a);
Вывод сообщение и задержка программы
writeln; write('Все Ok'); delay(1000);
Очистка экрана, возврат к главному меню и переход к метке menu2
clrscr; menu;
goto menu2;
Завершение составных операторов begin…end
end;
end
else
Если l не равно 1, не 2 и не 3, и не 4, и не 5, а равно 6, то выполняется
процедура вывода заставки - zast, после завершения которой происходит
переход к главному меню и метке menu2
if l=6 then begin zast; menu; goto menu2; end;
Если l не равно 1, не 2 и не 3, и не 4, не 5, и даже не 6, а - 7, то
выполняется процедура выхода из программы –exitt
if l=7 then exitt
Если l не равно 1, не 2 и не 3, и не 4, не 5, и даже не 6, и уж точно не
7, то выполняется процедура вывода сообщения об ошибке. После завершения
этой процедуры происходит переход к метке menu2
else
begin error; goto menu2; end;
{========================END_Proga========================}
ЗАВЕРШЕНИЕ ПРОГРАММЫ
END.
6 Список литературы
1. Фаронов В.В. Турбо Паскаль 7.0. Начальный курс. Учебное пособие.-М.:
«Нолидж», 1998.-616 с.
2. Вычислительная техника и программирование. Под редакцией А. В. Петрова
М, Высшая школа, 1990
3. Марченко А.И., Марченко Л.И. Программирование в среде Turbo-Pascal 7.0-
М., Бином Универсал, К.:Юниор,1997
4. http://www.rusdoc.ru
5. http://www.borland.ru
6. http://www.infocity.kiev.ua
Приложение А
Реализация продукции за год.
|№ |Переходящий |Приход |Расход, шт |Цена за |Остаток на |
| |остаток |продукции, | | |конец года |
| |продукции на |Шт | |1 шт | |
| |начало года | | | | |
|1 |45 |32 |21 |6.90 |386.40 |
|2 |234 |3454 |32 |5.67 |20729.52 |
|3 |79 |345 |34 |3.99 |1556.10 |
|4 |234 |4567 |54 |9.30 |44147.10 |
|5 |500 |566 |865 |4.98 |1000.98 |
|6 |5867 |11 |543 |4.67 |24914.45 |
|7 |560 |7789 |55 |2.90 |24052.60 |
|8 |129 |2000 |234 |4.89 |9266.55 |
|9 |123 |567 |435 |7.90 |2014.50 |
|10 |875 |907 |800 |8.90 |8739.80 |
|11 |743 |800 |600 |2.67 |2517.81 |
|12 |456 |800 |560 |6.89 |4795.44 |
|Итого: 144121.25 |
Приложение Б
uses crt,graph;
type
bas=record
n:integer;
e1,e2,e3:integer;
e4:real;
end;
label menu2; {метка}
var
c:char; {с - для ридкея}
o:real;
ww,l,nn,q,i:integer; {w,ww-для шапки,l-для меню и для удал
nn,o-редактирование q-для
обнавления
i-счетчик}
gd,gm:integer; {для графики}
pp,qq,n,mm:integer; {для добавки}
f,f2:file of bas; {файлы}
a,b:bas;
st:real; {сумма в таблице}
{-----------------------------------------вывод таблицы --------------------
-----------------}
procedure view(w:integer);
var
itog:real; {cумма в таблице, всего}
begin
window(1,1,80,6); textbackground(5);textcolor(15);
gotoxy(w,1);write('Реализация продукции за год');
textcolor(9);gotoxy(w-16,2);textbackground(0);
write('--------------------------------------------------------------');
textcolor(15);
gotoxy(w-15,4);write('N');
gotoxy(w-13,3);write('Переходящий остаток');
gotoxy(w-10,4);write('продукции на ');
gotoxy(w-10,5);write('начало года');
gotoxy(w+9,3);write('Приход');
gotoxy(w+8,4);write('продукции');
gotoxy(w+11,5);write('шт');
gotoxy(w+18,4);write('Расход');
gotoxy(W+20,5);write('шт');
gotoxy(w+26,4);write('Цена за');
gotoxy(w+27,5);write('1 шт');
gotoxy(w+35,4);write('Остаток на');
gotoxy(w+35,5);writeln('конец года');
textcolor(9); gotoxy(w-16,6);
write('--------------------------------------------------------------');
textcolor(15);
window(1,7,80,25);
reset(f); ww:=1; itog:=0;
repeat
writeln; read(f,a);
st:=((a.e1+a.e2)-a.e3)*a.e4;
itog:=itog+st;
textcolor(13);
gotoxy(w-15,ww);write(a.n);
textcolor(15);
gotoxy(w-5,ww);write(a.e1);
gotoxy(w+11,ww);write(a.e2);
gotoxy(w+20,ww);write(a.e3);
gotoxy(w+29,ww);write(a.e4:4:2);
gotoxy(w+37,ww);write(st:4:2);
ww:=ww+1;
if ww>=19 then {типа скролинга}
begin
if (ww=19) then
begin
writeln;
write('Для просмотра используйте клавишу
');
write(' Для продолжения -');
c:=readkey;
delline;
if c=#32 then ww:=ww-1 else break;
end;
end;
until eof(f);
textcolor(9); gotoxy(w-16,ww);
write('--------------------------------------------------------------');
textcolor(9);gotoxy(w+7,ww);
write('¦'); textbackground(5);
textcolor(10);write('Итого:',itog:4:2);
textbackground(0); textcolor(9);
write('+'); writeln;
end;
{----------------------------------------основное меню----------------------
----------------}
procedure menu;
begin
textmode(Co80); clrscr;
window(13,3,70,15); textbackground(14);textcolor(15);
gotoxy(1,3); write('Для дальнейшей работы с программой выберите
номерок:');
textbackground(0);
gotoxy(16,5); textcolor(10); write('1'); textcolor(7); write(' -
Просмотр');
gotoxy(16,6); textcolor(10); write('2'); textcolor(7); write(' -
Cоздать');
gotoxy(16,7); textcolor(10); write('3'); textcolor(7); write(' -
Добавить');
gotoxy(16,8); textcolor(10); write('4'); textcolor(7); write(' -
Удалить');
gotoxy(16,9); textcolor(10); write('5'); textcolor(7); write(' -
Редактировать');
gotoxy(16,10);textcolor(10); write('6'); textcolor(7); write(' -
Заставка');
gotoxy(16,11);textcolor(10); write('7'); textcolor(7); write(' - Выход');
gotoxy(16,13); write('Введите номер:');
textcolor(10+128);readln(l); textmode(Co80);
end;
{----------------------------------------------заставка---------------------
--------------------}
procedure zast;
var
xm,ym:integer; {xm,ym,x,y-координаты }
size:integer;
saucer:pointer; {size,saucer,k,kk-для движения}
k,kk:integer;
begin
clrscr; textmode(Co80); textcolor(white);
write('Показать заставку? (y/n)');
c:=readkey;
if c=#121 then
begin
initgraph(gd,gm,'bgi');
xm:=getmaxx div 4; ym:=getmaxy div 4;
settextstyle(2,0,5);
outtextxy(xm+100,10,'## Sergei Kovbasyuk ##');
size:=imagesize (xm+100,10,xm+275,10+20);
getmem(saucer,size);
getimage(xm+100,10,xm+275,10+20,saucer^);
putimage(xm+100,10,saucer^,xorput);
k:=0;kk:=0;i:=0;n:=0;
repeat
settextstyle(10,0,5); setcolor(i+1);
outtextxy((getmaxx div 5),(getmaxy div 4),'"Sorge pro"');
settextstyle(5,0,5); setcolor(15);
outtextxy((getmaxx-200),(getmaxy-250),'present');
settextstyle(3,0,1);
outtextxy(40,(getmaxy-50),'http://sorgepro.agava.ru');
outtextxy(290,(getmaxy-50),'e-mail: office@sorgepro.agava.ru');
settextstyle(2,0,5);
outtextxy(getmaxx-150,getmaxy-20,'Press ');
outtextxy(20,getmaxy-20,'(c)2000. All rights don''t reserved.');
k:=k+5;i:=i+1;
putimage(k,10,saucer^,xorput);
delay(50);
kk:=kk+5;
putimage(kk,10,saucer^,xorput);
if k>getmaxx-100 then begin k:=0; kk:=0 end;
until keypressed;
{-----------krugi------------}
for i:=0 to 399 do
begin
setcolor(red);
circle(200,100,i);
setcolor(green);
circle(400,100,i);
setcolor(yellow);
circle(300,300,i);
delay(10);
end;
for i:=399 downto 0 do
begin
setcolor(i);
circle(322,250,i);
delay(10);
end;
{----------end_krugi---------}
closegraph;
end;
end;
{------------------------------------Вывод об ошибке------------------------
---------------}
Procedure error;
begin
i:=0;
repeat
textmode(Co80);
clrscr;
gotoxy(24,8);textcolor(15);
write('ВЫ ВВЕЛИ НЕПРАВИЛЬНЫЙ НОМЕР');sound(185);delay(100);nosound;
clrscr;
gotoxy(24,8);textcolor(7);
write('ВЫ ВВЕЛИ НЕПРАВИЛЬНЫЙ НОМЕР');sound(174);delay(100);nosound;
i:=i+1;
until i=5;
nosound;
menu;
end;
{-----------------------------------------------Bыход-----------------------
------------------}
procedure exitt;
begin
clrscr;
initgraph(gd,gm,'bgi');
repeat
settextstyle(7,0,4);setcolor(15);
outtextxy(90,getmaxy div 4, 'Technical support by e-mail:');
settextstyle(1,0,4);setcolor(10);
outtextxy(120,(getmaxy div 4)+50, 'support@sorgepro.agava.ru');
settextstyle(7,0,4);setcolor(15);
outtextxy(140,(getmaxy div 4)+100, 'or visited our web site:');
settextstyle(1,0,4);setcolor(10);
outtextxy(120,(getmaxy div 4)+150, 'http://sorgepro.agava.ru');
settextstyle(2,0,5);setcolor(15);
outtextxy(getmaxx div 4,getmaxy-30,'(c)2000."Sorge pro".All rights
don''t reserved.');
until keypressed;
closegraph;
exit;
end;
{==========================Proga===========================}
BEGIN
zast;
assign (f,'k');
textmode(Co80);
{печать первого меню}
menu;
menu2:
{-------------------------------------------печать тaблицы------------------
-----------------}
if l=1 then
begin
view(27);
textcolor(15);
gotoxy(7, ww+1);
writeln('Для выхода нажмите или -возврат в главное меню.
');
c:=readkey;
textmode(Co80);
if c=#27 then begin menu; goto menu2 end
else exitt;
end
else
{-----------------------------------------Заново----------------------------
--------------------}
if l=2 then
begin
clrscr;
textbackground(14);textcolor(15);
writeln('Вы действительно хотите создать новые записи?');
writeln('!!!ПРЕДЫДУЩИЕ ЗАПИСИ БУДУТ УТЕРЯНЫ!!!');
textbackground(0);
gotoxy(1,4);
writeln('Для продолжения нажмите или -возврат в главное
меню.');
c:=readkey;
if c=#27 then begin menu; goto menu2 end
else
begin
writeln('Введите количество записей:');
read(q);
clrscr;
rewrite(f);
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);
clrscr;
writeln('ВСЁ OK.');
delay(1000);
menu; goto menu2;
end;
end
else
{----------------------------------Добавление записи------------------------
---------------}
if l=3 then
begin
clrscr;
textbackground(0);
textcolor(15);
writeln('Продолжить? (y/n)');
c:=readkey;
if c<>#121 then begin textmode(Co80); menu;goto menu2; end
else
begin
clrscr;
writeln('Введите количество добовляемых записей:');
read(mm);
clrscr;
reset(f); n:=filesize(f); seek(f,n);
pp:=n+1;
repeat
writeln('введи текущий номер продукции...');readln(qq); a.n:=pp;
writeln('введи переходящий остаток продукции на начало года...');
readln(a.e1);
writeln('введи приход продукции...'); readln(a.e2);
writeln('введи расход...');readln(a.e3);
writeln('введи цену за 1 шт...');readln(a.e4);
write(f,a);
pp:=pp+1;
until (qq=mm);
clrscr;
writeln('ВСЁ OK.');
delay(1000);
menu; goto menu2;
end;
end
else
{-----------------------------------------удаление записи-------------------
-----------------}
if l=4 then
begin
clrscr;
window(1,1,68,22);
view(17);
window(64,1,80,22);
textcolor(15);
writeln('Продолжить? (y/n)');
c:=readkey;
if c<>#121 then begin textmode(Co80); menu;goto menu2; end
else
begin
write('Введи номер:');
readln(nn);
if nn>filesize(f) then begin error; goto menu2; end;
{удаление записи:запись в новый файл}
reset(f);
assign (f2,'k2');
rewrite(f2);
l:=0;q:=0;n:=filesize(f);
repeat
l:=l+1;
if l<>nn then
begin
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);
end;
until l=n;
{удаление записи: перезапись}
reset(f2); rewrite(f);
repeat
read(f2,b);
a.n:=b.n; a.e1:=b.e1; a.e2:=b.e2; a.e3:=b.e3; a.e4:=b.e4;
write(f,a);
until eof(f2);
writeln;
writeln('Всё Ok!');
delay(1000);
writeln('Reload-');
write('Exit-');
c:=readkey;
if c=#27 then begin menu; goto menu2; end
else begin textmode(Co80); l:=4; goto menu2; end;
end;
end
else
{---------------------------------------редактирование----------------------
----------------}
if l=5 then
begin
view(27);
textcolor(15);
writeln('Продолжить? (y/n)');
c:=readkey;
if c<>#121 then begin textmode(Co80); menu;goto menu2; end
else
begin
write('Введите номер для редактирования:'); read(nn);
if nn>filesize(f) then begin error; goto menu2; end;
clrscr;
i:=27;
reset(f); seek(f,nn-1);
read(f,a);
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);
writeln('Изменить переходящий остаток продукции на начало года? (y/n)');
c:=readkey;
if c=#121 then begin write('Вводим новое:');read(nn); a.e1:=nn; end;
writeln;
writeln('Изменить приход продукции? (y/n)');c:=readkey;
if c=#121 then begin write('Вводим новое:'); read(nn);a.e2:=nn; end;
writeln;
writeln('Изменить расход? (y/n)');c:=readkey;
if c=#121 then begin write('Вводим новое:'); read(nn);a.e3:=nn; end;
writeln;
writeln('Изменить цену за 1 шт? (y/n)');c:=readkey;
if c=#121 then begin write('Вводим новое:'); read(o);a.e4:=o; end;
write(f,a); writeln; write('Все Ok'); delay(1000);
clrscr; menu;
goto menu2;
end;
end
else
{--------------------------------------вывод заставки-----------------------
-------------}
if l=6 then begin zast; menu; goto menu2; end;
{---------------------------------------выход-------------------------------
---------------}
if l=7 then exitt
else
begin error; goto menu2; end;
{========================END_Proga========================}
END.
| Writed by Sergei Kovbasyuk |
| |
|(c)2000."Sorge pro". Rights don't reserved. |
|e-mail:office@sorgepro.agava.ru |
|http://sorgepro.agava.ru |
Страницы: 1, 2, 3
|