Смекни!
smekni.com
Информатика

Создание справочника Парфюмерный магазин при помощи программы Turbo Pascal (стр. 6 из 7)

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:&bsol;prog&bsol;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:&bsol;prog&bsol;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:&bsol;prog&bsol;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:&bsol;prog&bsol;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:&bsol;prog&bsol;bd.dat');

assign(fDel,'e:&bsol;prog&bsol;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);

readln(f,Baza.FMany);

readln(f,Baza.FSim);

If Baza.FKod<>tek^.nomer then {Если текущая позиция в списке не

равно текущему коду товара то все позиции товара переносятся

во временный файл bddvr}

begin

writeln(fdel,Baza.FKod);

writeln(fdel,Baza.FRazdel);

writeln(fdel,Baza.FPodrazdel);

writeln(fdel,Baza.FName);

writeln(fdel,Baza.FSeria);

writeln(fdel,Baza.FProizvod);

writeln(fdel,Baza.FOpisan);

writeln(fdel,Baza.FMany);

writeln(fdel,Baza.FSim);

end

end;

close(f);

close(fDel);

reset(fDel);

rewrite(f);

while not Eof(fDel) do {После переноса во временный файл, но уже без

удаленного элемента происходит перезапись файла бд из временного}

begin

readln(fDel,Baza.FKod); writeln(f,Baza.FKod);

readln(fDel,Baza.FRazdel); writeln(f,Baza.FRazdel);

readln(fDel,Baza.FPodRazdel); writeln(f,Baza.FPodrazdel);

readln(fDel,Baza.FName); writeln(f,Baza.FName);

readln(fDel,Baza.FSeria); writeln(f,Baza.FSeria);

readln(fDel,Baza.FProizvod); writeln(f,Baza.FProizvod);

readln(fDel,Baza.FOpisan); writeln(f,Baza.FOpisan);

readln(fDel,Baza.FMany); writeln(f,Baza.FMany);

readln(fDel,Baza.FSim); writeln(f,Baza.FSim);

end;

close(fdel);

close(f);

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

end;

if ord(ch)=110 then begin

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

end;

end;

Procedure PrintF; {Процедура Печать в файл}

var fname1,fname2,fname3:string; {Переменные указывающие путь к файлу}

fotchet:text; {переменная файла отчета}

begin

clrscr;

GoToXY(10,10); Textcolor(11);writeln('Для печати всех позиций текущего подраздела нажмите F3');

GoToXY(10,12);writeln('Для печати текущей позиций нажмите F5');

GoToXY(10,14);writeln('Для выхода нажмите Backspace');

repeat

ch:=readkey;

if (ord(ch)=61) or (ord(ch)=63) then {Вводится имя будущего

файла и создается шапка в файле отчета}

begin

fname1:='e:&bsol;prog&bsol;';

fname3:='.txt';

GoToXY(10,16);writeln('Введите имя файла в который необходимо сохранить отчет');

GoToXY(10,17);writeln('и нажмите ввод. Файл отчета находится в корневой папке');

GoToXY(10,19);readln(fname2);

assign(fotchet,fname1+fname2+fname3);

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

reset(f);

rewrite(fotchet);

end;

if ord(ch)=61 then {Если нажата F3 то создается отчет состоящий из

товаров текущего подраздела}

begin

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.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:&bsol;prog&bsol;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:&bsol;prog&bsol;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; {Считать общее количество позиций}

 
назад
читать дальше
1
2
3
4
5
6
7
НАПИШИТЕ НАМ
Copyright © Smekni.com. All rigths reserved.