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);
с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);
Вывод сообщения о возможности продолжения удаления новых записей или возврата к главному меню