Курсовая работа: Создание справочника "Парфюмерный магазин" при помощи программы Turbo Pascal
end;
procedure
podRazdel; {Считывает из файла разделы и подразделы в
зависимости от выбранного и выводит на экран}
var
PodRaz:array[1..16] of string;{Массив разделов и под разделов}
z:integer; {Строка с которой начинается вывод пунктов меню}
f:text; {Файловая переменная}
d:string; {Переменная которой присваивается очередное считанное значение из
файла}
begin
assign
(f,'e:\prog\razdel.dat'); {Файл который содержит разделы и подразделы}
reset(f);
nabor:=0;
while not Eof(f) do
{До тех пор
пока не конец файла делать
если очередная строка файла соответствует выбранному разделу то
записать ее в массив}
begin
Readln(f,d);
if d=rozd
then
begin
nabor:=nabor+1;
Readln(f,d);
PodRaz[nabor]:=d;
end
else Readln(f,d);
end;
close(f);
{Вывод на экран пунктов и подпунктов меню из массива, закрашенных цветами
из массива
цветов}
z:=3;
for i:=1 to nabor do
begin
Textcolor(men[i]);
GoToXY(2,z);
writeln(PodRaz[i]);
z:=z+1
end;
end;
procedure
ADDSpisok;{Добавляет в динамический список код товара, для
дальнейшего перемещения}
begin
new(tek); {создаем новый элемент}
tek^.nomer:=Baza.FKod;{записываем данное}
tek^.next:=nach;{устанавливаем указатели}
nach:=tek; {для поддержания целостности списка}
kolvo:=kolvo+1; {Увеличиваем количество добавленных элементов}
end;
procedure
Tablo;
{Процедура
выводит позиции товаров на экран}
var
opis1,opis2,opis3:string; {Разбивает строку на три части т.к. не влезает}
begin
GoToXY(22,3);Textcolor(10);writeln('Kод товара ');
GoToXY(33,3);Textcolor(11);writeln(Baza.FKod);
GoToXY(43,3);Textcolor(10);writeln('Раздел ');
GoToXY(50,3);Textcolor(11);writeln(Baza.FRazdel);
GoToXY(60,3);Textcolor(10);writeln('Подраздел ');
GoToXY(70,3);Textcolor(11);writeln(Baza.FPodRazdel);
GoToXY(22,5);Textcolor(10);writeln('Название: ');
opis1:=copy(Baza.FName,1,58);
opis2:=copy(Baza.FName,59,117);
opis3:=copy(Baza.FName,118,126);
GoToXY(22,6);Textcolor(11);writeln(Opis1);
GoToXY(22,7);Textcolor(11);writeln(Opis2);
GoToXY(22,8);Textcolor(11);writeln(Opis3);
GoToXY(22,10);Textcolor(10);writeln('Серия:');
GoToXY(30,10);Textcolor(11);writeln(Baza.FSeria);
GoToXY(22,12);Textcolor(10);writeln('Производитель:');
GoToXY(22,13);Textcolor(11);writeln(Baza.FProizvod);
opis1:=copy(Baza.FOpisan,1,58);
opis2:=copy(Baza.FOpisan,59,117);
opis3:=copy(Baza.FOpisan,118,126);
GoToXY(22,15);Textcolor(10);writeln('Описание:');
GoToXY(22,16);Textcolor(11);writeln(Opis1);
GoToXY(22,17);Textcolor(11);writeln(Opis2);
GoToXY(22,18);Textcolor(11);writeln(Opis3);
GoToXY(22,20);Textcolor(10);writeln('Стоимость');
GoToXY(35,20);Textcolor(11);writeln(Baza.FMany);
end;
procedure
writeSpisok; {Процедура вывода позиций товара чей код
последним записан в список}
var
f:text;
begin
if
ScetRP<>0 then
begin
tek:=nach;{Считать первый элемент списка и найти в файле товар с
таким кодом}
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.FKod=tek^.nomer Then {Если код товара из списка = коду товара
из файла значит вывести на экран позиции товара}
begin
clrscr;
shapka; podRazdel;
GoToXY(1,1); {write ('MRazdel=',MRazdel,' Podrazd=',lom);}
GoToXY(60,1);
Write('Всего позиций: ',ScetRP);
Tablo;
end;
end;
close(f);
end
else
begin
GoToXY(22,11);Textcolor(10);writeln('Товаров нет, для выхода из данной
категории нажмите ESC');
f1:=7;f2:=11;f3:=7;f4:=7;f8:=7;pu:=7;pd:=7;f10:=7; {Цвета нижних кнопок}
Text1:='Двигайтесь кнопками';
Text2:='PageDown,PageUp '; {Подсказки}
Text3:='Для выхода нажмите ';
Text4:='ESC
';
shapka;podrazdel;
{writeln('Enter');
readln;}
end;
end;
procedure
DelSpisok; {Удаляет последний элемент списка}
begin
tek:=nach; {Переходим в начало}
nach:=tek^.next; {Связываем}
dispose(tek); {Удаляем}
tek:=nach;
kolvo:=kolvo-1; {Уменьшаем количество элементов в списке на 1}
end;
procedure
RP; {Считывает из файла первый товар соответствующий разделу
и подразделу}
{var lon:boolean;
{ f:text;}
begin
{lon:=false;{}
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.FRazdel=MRazdel) and (Baza.FPodRazdel=Podrazd) then
begin
addspisok; {Добавляем в список}
break;
end;
end;
end;
procedure
PoiskFPR; {Поиск элемента соответствующей разделу и
подразделу в списке и в файле}
var {f:text;}
Good,Nal:boolean;
zed:integer;
begin
assign (f,'e:\prog\bd.dat');
reset(f);
nal:=false;
while (not Eof(f)) or (nal=false) 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.FRazdel=MRazdel) and (Baza.FPodRazdel=Podrazd)) then
begin
{Если очередной товар в бд соответствует разделу и
подразделу тогда проверяется есть ли очередной код товара
в списке, если есть то ищет в бд следующий товар, если
нет то добавляет в список}
zed:=0;
Good:=false;
d:=nil;
tek:=nach;
while (tek<>NIL) or (Good=false) do
begin
if tek^.nomer = Baza.FKod then Good:=true;
d:=tek;
tek:=tek^.next;
zed:=zed+1;
if zed=kolvo then break;
end;
if Good<>true then
begin
nal:=true;
break;
end;
end;
end;
close(f);
end;
procedure
schet; {Процедура выводит количество позиций в выбранном разделе
и подразделе}
{var
f:text;{}
begin
ScetRP:=0;
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.FRazdel=MRazdel) and (Baza.FPodRazdel=Podrazd) then
ScetRP:=ScetRP+1;
end;
close(f);
end;
Procedure
Del; {Процедура удаление товара}
var
FDel:text;{Временный файл для не удаленных товаров}
begin
GoToXY(27,21);Textcolor(21);
writeln('Вы
действительно хотите удалить файл Y/N');
ch:=readkey;
if (ord(ch)=121) or (ord(ch)=173) then
begin
assign(f,'e:\prog\bd.dat');
assign(fDel,'e:\prog\bdvr.dat');
reset(f);
rewrite(fdel);
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);
Страницы: 1, 2, 3, 4, 5, 6, 7, 8, 9 |
