GoToXY(10,19);readln(fname2);
assign(fotchet,fname1+fname2+fname3);
assign(f,'e:\prog\bd.dat');
reset(f);
rewrite(fotchet);
end;
if ord(ch)=61 then {Если нажата F3 то создается отчет состоящий из
товаров текущего подраздела}
begin
writeln(fotchet,'Отчет по подразделу ');
writeln;
writeln(fotchet,'---------------------------------------------------------');
while not Eof(f) do
readln(f,Baza.FKod);
readln(f,Baza.FRazdel);
readln(f,Baza.FPodRazdel);
readln(f,Baza.FName);
readln(f,Baza.FSeria);
readln(f,Baza.FProizvod);
readln(f,Baza.FOpisan);
readln(f,Baza.FMany);
readln(f,Baza.FSim);
if (Baza.FRazdel=MRazdel) and (Baza.FPodRazdel=Podrazd) then
write (fotchet,'Код товара '); writeln(fotchet,Baza.FKod);
write (fotchet,'Название ');writeln(fotchet,Baza.FName);
write (fotchet,'Серия ');writeln(fotchet,Baza.FSeria);
write (fotchet,'Производитель ');writeln(fotchet,Baza.FProizvod);
write (fotchet,'Описание ');writeln(fotchet,Baza.FOpisan);
write (fotchet,'Цена ');writeln(fotchet,Baza.FMany);
writeln(fotchet,'-----------------------------------------');
close(fotchet);
close(f);
if ord(ch)=63 then {Если нажата F5 то в файл отчета добавляется только
текущая позиция}
tek:=nach;
writeln(fotchet,'Отчет по текущему товару');
if (Baza.FKod=tek^.nomer) then
until (ord(ch)=8) or (ord(ch)=61) or (ord(ch)=63);
{Закрыте файлов и вывод на прежнее место}
clrscr;
shapka;
writespisok;
procedure NewTovar; {Процедура добавления нового товара}
var f1,f2,f3:text; {Файловые переменные}
kod:integer; {Переменная которой присваивается новый код товара}
Baza.FRazdel:=MRazdel; Baza.FPodRazdel:=PodRazd;
{Форма заполнения данных о новом товаре}
GoToXY(10,1); Textcolor(10); Writeln('Заполните форму. После заполнение очередного пункта нажмите ввод');
GoToXY(3,4); writeln('Раздел ',Baza.FRazdel);
GoToXY(3,5); writeln('Подраздел ',Baza.FPodRazdel);
GoToXY(3,6); Writeln('Опешите назначение товара');
GoToXY(3,8); Writeln('Введите серию товара, если нет то введите символ "-" ');
GoToXY(3,10); Writeln('Введите производителя');
GoToXY(3,12); Writeln('Опешите товар подробнее');
GoToXY(3,22); Writeln('Цена товара');
GoToXY(3,5); Textcolor(11);
GoToXY(3,7);readln(Baza.FName);
GoToXY(3,9);readln(Baza.FSeria);
GoToXY(3,11);readln(Baza.FProizvod);
GoToXY(3,13);readln(Baza.FOpisan);
GoToXY(20,22);readln(Baza.FMany);
GoToXY(10,23);Textcolor(10); Writeln('Сохранить Y, Отмена N');
ch:=readkey;
if (ord(ch)= 121) or (ord(ch)= 173) then {Если нажата Y на английском
и Н на русском, то считывается из файла, который хранит коды товаров,
запоминает последний, увеличивает на единицу и добавляет новый код
в файл кодов}
assign(f2,'e:\prog\kod.dat');
reset(f2);
while not Eof(f2) do readln(f2,Kod);
close(f2);
Baza.FKod:=Kod+1;
append(f2);
write(f2,'');
writeln(f2,Baza.FKod);
assign(f3,'e:\prog\bd.dat');
{Записывает в БД информацию о новом товаре}
append(f3);
writeln(f3,Baza.FKod);
writeln(f3,Baza.FRazdel);
writeln(f3,Baza.FPodRazdel);
writeln(f3,Baza.FName);
writeln(f3,Baza.FSeria);
writeln(f3,Baza.FProizvod);
writeln(f3,Baza.FOpisan);
writeln(f3,Baza.FMany);
writeln(f3,'*');
close(f3);
GoToXY(18,12); writeln('Запись сохранена для продолжения нажмите ввод');
readln;
podRazdel;
GoToXY(27,21);Textcolor(21); writeln('Для продолжения работы нажмите ESC');
procedure vivod; {Основная процедура вывода}
{Общий принцип: На экране появляется первый элемент выбранного раздела и подраздела
Далее пользователь при помощи кнопок PageUp PageDown перемещается по всем товарам}
var hod:integer; {Счетчик ходв}
schet; {Считать общее количество позиций}
f1:=7;f2:=11;f3:=7;f4:=11;f8:=11;pu:=11;pd:=11;f10:=7; {Переменные цвета нижних кнопок}
Text1:='Двигайтесь кнопками';
Text2:='PageDown,PageUp'; {Подсказки}
Text3:='Для выхода нажмите';
Text4:='ESC';
RP; {Выводится первый товар}
hod:=1; {Сделан первый ход}
writeSpisok; {Вывести на экран товар соответствующий коду товара из списка}
repeat
if (ord(ch)=81) and (ScetRP<>0) then {Если нажата PageDown}
if ScetRP<>hod then
hod:=hod+1;
PoiskFPR; {Считывается весь файл и проверяется соответствие каждого товара
разделу и подразделу и проверяет входит ли код товара в список
если входит то ищет дальше если нет то...}
addspisok; {Если нет то добавляет в список}
writeSpisok; {Выводит товар соответствующий коду товара из списка}
if (ord(ch)=73) and (ScetRP<>0) then {Если нажата PageUp}
if hod<>1 then
hod:=hod-1;
DelSpisok; {Удаляет последний элемент списка}
writeSpisok; {Выводит уже другой последний элемент}
if ord(ch)=60 then NewTovar; {Если нажата F2 то в данный раздел и подраздел ввести новый товар}
if (ord(ch)=66) and (ScetRP<>0) then Del;{Если нажата клавиша F8, то процедура удаление товара}
if (ord(ch)=62) and (ScetRP<>0) then PrintF;{Если нажата клавиша F4, то процедура создания отчета}
until ord(ch)=27;
procedure Vhod; {Процедура обработки события по нажатию клавише ввод}
Lom:=1;
if ord(ch)=13 then {Если нажат ввод}
for i:=1 to nabor do
if (men[i]=15) then {Если текущий цвет белый то... }
if razdel=1 then {Если открыт подраздел...}
podrazd:=Lom; {Присвоить подразделу его порядковый номер}
vivod; {Вывод на экран}
kolvo:=0;
if (Lom=1) and (razdel=0) then
rozd:='1'; {Номер раздела}
MRazdel:=1;{Номер подраздела}
razdel:=1; {Показывает что открыт подраздел, а не раздел}
end;{Далее аналогично}
if (Lom=2) and (razdel=0) then begin rozd:='2'; MRazdel:=2; razdel:=1; end;
if (Lom=3) and (razdel=0) then begin rozd:='3'; MRazdel:=3; razdel:=1; end;
if (Lom=4) and (razdel=0) then begin rozd:='4'; MRazdel:=4; razdel:=1; end;
if (Lom=5) and (razdel=0) then begin rozd:='5'; MRazdel:=5; razdel:=1; end;
if (Lom=6) and (razdel=0) then begin rozd:='6'; MRazdel:=6; razdel:=1; end;
if (Lom=7) and (razdel=0) then begin rozd:='7'; MRazdel:=7; razdel:=1; end;
if (Lom=8) and (razdel=0) then begin rozd:='8'; MRazdel:=8; razdel:=1; end;
if (Lom=9) and (razdel=0) then begin rozd:='9'; MRazdel:=9; razdel:=1; end;
Lom:=Lom+1;
if ord(ch)=8 then {Если нажата <- то вернутся назад}
rozd:='0'; {Открывает раздел}
razdel:=0; {Показывает что открыт раздел}
podRazdel; {Процедура создание подразделов}
procedure Poisk;
var punkt:integer; {Переменная ввода выбранного критерия поиска}
NSP:string; {Переменная условия поиска}
fol:integer; {Переменная счетчик}
fol:=0; {Счетчик указывающий количество найденных позиций}
GoToXY(10,2); Textcolor(10); Writeln('Выберете критерии поиска');
{GoToXY(10,3); Writeln('и нажмите ввод');}
Textcolor(11); GoToXY(12,6); Writeln('1: Название');
GoToXY(12,8); Writeln('2: Серия');
GoToXY(12,10); Writeln('3: Производитель');
GoToXY(12,12); Writeln('4: Отмена');
if (ord(ch)=49) or (ord(ch)=50) or (ord(ch)=51) then
{GoToXY(12,14); readln(punkt);}
GoToXY(12,14);writeln('Введите условие и нажмите ввод');
GoToXY(12,16);readln(nsp);
while (not Eof(f)) do {Считывает очередной товар}
If (Baza.FName=NSP) or (Baza.FSeria=Nsp) or (Baza.FProizvod=Nsp) then
Tablo;
f1:=7;f2:=7;f3:=7;f4:=7;f8:=7;pu:=7;pd:=11; f10:=7; {Цвета нижних кнопок}
Text1:='Двигайтесь кнопкой';
Text2:='PageDown'; {Подсказка}
Shapka;
fol:=fol+1;
until (ord(ch)=81) or (ord(ch)=27);
f1:=11;f2:=7;f3:=11;f4:=7;f8:=7;pu:=7;pd:=11;f10:=11; {Цвета нижних кнопок}
if ord(ch)=27 then break;
GoToXY(15,12);Textcolor(4);
if fol>0 then writeln('Больше совпадений нет, для продолжения работы нажмите ввод')
else writeln('Cовпадений нет, для продолжения работы нажмите ввод');
break;
until ord(ch)=52;
Text1:='Двигайтесь курсором';
Text2:='до нужного раздела'; {Подсказка}
Text3:='и нажмите ВВОД';
Text4:='Для возврата <-';
procedure help;
var k:string;
n:integer;
n:=0;
assign(f,'e:\prog\help.dat');
while not Eof(f) do {Считывает очередной товар}
if (n=24) or (n=48) or (n=72) or (n=96) or (n=120) or (n=120) then readln;{ch:=readkey;}
readln(f,k);
writeln(k);
n:=n+1;
procedure perem; {Процедура перемещает элементы меню}
{Массив цветов. Первый белый остальные зеленые}
men[1]:=15; men[2]:=2; men[3]:=2; men[4]:=2; men[5]:=2; men[6]:=2; men[7]:=2;
men[8]:=2; men[9]:=2; men[10]:=2;men[11]:=2;men[12]:=2;men[13]:=2; men[14]:=2; men[15]:=2;
podRazdel; {Процедура вывода подразделов}
strok:=1; {Текущая строка}
GoToXY(79,1);
ch:=readkey; {Просит ввести курсором направления движения}
if (ord(ch)=80) then {Если вниз тогда текущий становится белым,
а нижний становится зеленым}
if (men[i]=15) and (strok<>nabor) then
men[strok]:=2;
men[strok+1]:=15;
end
else strok:=strok+1;
if ord(ch)=72 then {Если вверх, то текущий белым, а верхний зеленым}
if (men[i]=15) and (strok<>1)then
men[strok-1]:=15;
if ord(ch)=59 then Help; {Если нажата клавиша F1}
if ord(ch)=61 then Poisk;{Если нажата клавиша F3}
{До тех пор пока не нажат ввод или назад или выход}
until (ord(ch)=13) or (ord(ch)=8) or (ord(ch)=68);
vof:=true;
if (ord(ch)<>68) then vhod;{Если не нажат выход то вход в очередной раздел или подраздел}
{Основная программа}
rozd:='0'; {Подраздел не выбран, значит выводить главный раздел}
razdel:=0; {Показывает что открыт раздел, а не подраздел}
vof:=false; {Переменная показывает что перемещений не было}
f1:=11;f2:=7;f3:=11;f4:=7;f8:=7;pu:=7;pd:=7;f10:=11; {Цвета нижних кнопок}
shapka; {Процедура выводит разметку на экран}
perem; {Процедура перемещения курсором в разделах и подразделах}
until (ord(ch)=68) ; {До тех пор пока не нажат пункт EXIT}
end.
Страницы: 1, 2, 3, 4, 5, 6, 7, 8