Создание справочника "Парфюмерный магазин" при помощи программы Turbo Pascal

readln(f,Baza.FMany);

readln(f,Baza.FSim);

if (Baza.FRazdel=MRazdel) and (Baza.FPodRazdel=Podrazd) then

begin

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,'-----------------------------------------');

end;

end;

close(fotchet);

close(f);

end;

if ord(ch)=63 then {Если нажата F5 то в файл отчета добавляется только

текущая позиция}

begin

tek:=nach;

writeln(fotchet,'Отчет по текущему товару');

writeln;

writeln(fotchet,'---------------------------------------------------------');

while not Eof(f) do

begin

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.FKod=tek^.nomer) then

begin

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,'-----------------------------------------');

end;

end;

close(fotchet);

close(f);

end;

until (ord(ch)=8) or (ord(ch)=61) or (ord(ch)=63);

{Закрыте файлов и вывод на прежнее место}

clrscr;

shapka;

writespisok;

end;

procedure NewTovar; {Процедура добавления нового товара}

var f1,f2,f3:text; {Файловые переменные}

kod:integer; {Переменная которой присваивается новый код товара}

begin

clrscr;

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 на английском

и Н на русском, то считывается из файла, который хранит коды товаров,

запоминает последний, увеличивает на единицу и добавляет новый код

в файл кодов}

begin

clrscr;

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);

close(f2);

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;

end;

clrscr;

shapka;

podRazdel;

GoToXY(27,21);Textcolor(21); writeln('Для продолжения работы нажмите ESC');

end;

procedure vivod; {Основная процедура вывода}

{Общий принцип: На экране появляется первый элемент выбранного раздела и подраздела

Далее пользователь при помощи кнопок PageUp PageDown перемещается по всем товарам}

var hod:integer; {Счетчик ходв}

begin

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

ch:=readkey;

if (ord(ch)=81) and (ScetRP<>0) then {Если нажата PageDown}

begin

if ScetRP<>hod then

begin

hod:=hod+1;

PoiskFPR; {Считывается весь файл и проверяется соответствие каждого товара

разделу и подразделу и проверяет входит ли код товара в список

если входит то ищет дальше если нет то...}

addspisok; {Если нет то добавляет в список}

writeSpisok; {Выводит товар соответствующий коду товара из списка}

end;

end;

if (ord(ch)=73) and (ScetRP<>0) then {Если нажата PageUp}

begin

if hod<>1 then

begin

hod:=hod-1;

DelSpisok; {Удаляет последний элемент списка}

writeSpisok; {Выводит уже другой последний элемент}

end;

end;

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;

end;

procedure Vhod; {Процедура обработки события по нажатию клавише ввод}

begin

Lom:=1;

if ord(ch)=13 then {Если нажат ввод}

begin

for i:=1 to nabor do

begin

if (men[i]=15) then {Если текущий цвет белый то... }

begin

if razdel=1 then {Если открыт подраздел...}

begin

podrazd:=Lom; {Присвоить подразделу его порядковый номер}

vivod; {Вывод на экран}

kolvo:=0;

end;

if (Lom=1) and (razdel=0) then

begin

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;

end;

Lom:=Lom+1;

end;

end;

if ord(ch)=8 then {Если нажата <- то вернутся назад}

begin

rozd:='0'; {Открывает раздел}

razdel:=0; {Показывает что открыт раздел}

end;

podRazdel; {Процедура создание подразделов}

end;

procedure Poisk;

var punkt:integer; {Переменная ввода выбранного критерия поиска}

NSP:string; {Переменная условия поиска}

fol:integer; {Переменная счетчик}

begin

clrscr;

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: Отмена');

repeat

ch:=readkey;

if (ord(ch)=49) or (ord(ch)=50) or (ord(ch)=51) then

begin

{GoToXY(12,14); readln(punkt);}

GoToXY(12,14);writeln('Введите условие и нажмите ввод');

GoToXY(12,16);readln(nsp);

assign(f,'e:\prog\bd.dat');

reset(f);

while (not Eof(f)) do {Считывает очередной товар}

begin

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.FName=NSP) or (Baza.FSeria=Nsp) or (Baza.FProizvod=Nsp) then

begin

clrscr;

Tablo;

f1:=7;f2:=7;f3:=7;f4:=7;f8:=7;pu:=7;pd:=11; f10:=7; {Цвета нижних кнопок}

Text1:='Двигайтесь кнопкой';

Text2:='PageDown'; {Подсказка}

Text3:='Для выхода нажмите';

Text4:='ESC';

Shapka;

fol:=fol+1;

repeat

ch:=readkey;

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;

end;

end;

close(f);

clrscr;

GoToXY(15,12);Textcolor(4);

if fol>0 then writeln('Больше совпадений нет, для продолжения работы нажмите ввод')

else writeln('Cовпадений нет, для продолжения работы нажмите ввод');

readln;

break;

end;

until ord(ch)=52;

clrscr;

Text1:='Двигайтесь курсором';

Text2:='до нужного раздела'; {Подсказка}

Text3:='и нажмите ВВОД';

Text4:='Для возврата <-';

Shapka;

podRazdel;

end;

procedure help;

var k:string;

n:integer;

begin

clrscr;

n:=0;

assign(f,'e:\prog\help.dat');

reset(f);

while not Eof(f) do {Считывает очередной товар}

begin

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;

end;

readln;

close(f);

clrscr;

Shapka;

podRazdel;

end;

procedure perem; {Процедура перемещает элементы меню}

begin

{Массив цветов. Первый белый остальные зеленые}

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;

repeat

podRazdel; {Процедура вывода подразделов}

strok:=1; {Текущая строка}

GoToXY(79,1);

ch:=readkey; {Просит ввести курсором направления движения}

if (ord(ch)=80) then {Если вниз тогда текущий становится белым,

а нижний становится зеленым}

begin

for i:=1 to nabor do

begin

if (men[i]=15) and (strok<>nabor) then

begin

men[strok]:=2;

men[strok+1]:=15;

end

else strok:=strok+1;

end;

end;

if ord(ch)=72 then {Если вверх, то текущий белым, а верхний зеленым}

begin

for i:=1 to nabor do

begin

if (men[i]=15) and (strok<>1)then

begin

men[strok]:=2;

men[strok-1]:=15;

end

else strok:=strok+1;

end;

end;

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;{Если не нажат выход то вход в очередной раздел или подраздел}

end;

{Основная программа}

begin

rozd:='0'; {Подраздел не выбран, значит выводить главный раздел}

razdel:=0; {Показывает что открыт раздел, а не подраздел}

vof:=false; {Переменная показывает что перемещений не было}

repeat

clrscr;

f1:=11;f2:=7;f3:=11;f4:=7;f8:=7;pu:=7;pd:=7;f10:=11; {Цвета нижних кнопок}

Text1:='Двигайтесь курсором';

Text2:='до нужного раздела'; {Подсказка}

Text3:='и нажмите ВВОД';

Text4:='Для возврата <-';

shapka; {Процедура выводит разметку на экран}

GoToXY(79,1);

perem; {Процедура перемещения курсором в разделах и подразделах}

until (ord(ch)=68) ; {До тех пор пока не нажат пункт EXIT}

end.