49956 (Создание справочника "Парфюмерный магазин" при помощи программы Turbo Pascal), страница 5

2016-07-30СтудИзба

Описание файла

Документ из архива "Создание справочника "Парфюмерный магазин" при помощи программы Turbo Pascal", который расположен в категории "". Всё это находится в предмете "информатика" из 1 семестр, которые можно найти в файловом архиве . Не смотря на прямую связь этого архива с , его также можно найти и в других разделах. Архив можно найти в разделе "курсовые/домашние работы", в предмете "информатика, программирование" в общих файлах.

Онлайн просмотр документа "49956"

Текст 5 страницы из документа "49956"

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

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:\prog\';

fname3:='.txt';

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

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

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

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;

Свежие статьи
Популярно сейчас
Зачем заказывать выполнение своего задания, если оно уже было выполнено много много раз? Его можно просто купить или даже скачать бесплатно на СтудИзбе. Найдите нужный учебный материал у нас!
Ответы на популярные вопросы
Да! Наши авторы собирают и выкладывают те работы, которые сдаются в Вашем учебном заведении ежегодно и уже проверены преподавателями.
Да! У нас любой человек может выложить любую учебную работу и зарабатывать на её продажах! Но каждый учебный материал публикуется только после тщательной проверки администрацией.
Вернём деньги! А если быть более точными, то автору даётся немного времени на исправление, а если не исправит или выйдет время, то вернём деньги в полном объёме!
Да! На равне с готовыми студенческими работами у нас продаются услуги. Цены на услуги видны сразу, то есть Вам нужно только указать параметры и сразу можно оплачивать.
Отзывы студентов
Ставлю 10/10
Все нравится, очень удобный сайт, помогает в учебе. Кроме этого, можно заработать самому, выставляя готовые учебные материалы на продажу здесь. Рейтинги и отзывы на преподавателей очень помогают сориентироваться в начале нового семестра. Спасибо за такую функцию. Ставлю максимальную оценку.
Лучшая платформа для успешной сдачи сессии
Познакомился со СтудИзбой благодаря своему другу, очень нравится интерфейс, количество доступных файлов, цена, в общем, все прекрасно. Даже сам продаю какие-то свои работы.
Студизба ван лав ❤
Очень офигенный сайт для студентов. Много полезных учебных материалов. Пользуюсь студизбой с октября 2021 года. Серьёзных нареканий нет. Хотелось бы, что бы ввели подписочную модель и сделали материалы дешевле 300 рублей в рамках подписки бесплатными.
Отличный сайт
Лично меня всё устраивает - и покупка, и продажа; и цены, и возможность предпросмотра куска файла, и обилие бесплатных файлов (в подборках по авторам, читай, ВУЗам и факультетам). Есть определённые баги, но всё решаемо, да и администраторы реагируют в течение суток.
Маленький отзыв о большом помощнике!
Студизба спасает в те моменты, когда сроки горят, а работ накопилось достаточно. Довольно удобный сайт с простой навигацией и огромным количеством материалов.
Студ. Изба как крупнейший сборник работ для студентов
Тут дофига бывает всего полезного. Печально, что бывают предметы по которым даже одного бесплатного решения нет, но это скорее вопрос к студентам. В остальном всё здорово.
Спасательный островок
Если уже не успеваешь разобраться или застрял на каком-то задание поможет тебе быстро и недорого решить твою проблему.
Всё и так отлично
Всё очень удобно. Особенно круто, что есть система бонусов и можно выводить остатки денег. Очень много качественных бесплатных файлов.
Отзыв о системе "Студизба"
Отличная платформа для распространения работ, востребованных студентами. Хорошо налаженная и качественная работа сайта, огромная база заданий и аудитория.
Отличный помощник
Отличный сайт с кучей полезных файлов, позволяющий найти много методичек / учебников / отзывов о вузах и преподователях.
Отлично помогает студентам в любой момент для решения трудных и незамедлительных задач
Хотелось бы больше конкретной информации о преподавателях. А так в принципе хороший сайт, всегда им пользуюсь и ни разу не было желания прекратить. Хороший сайт для помощи студентам, удобный и приятный интерфейс. Из недостатков можно выделить только отсутствия небольшого количества файлов.
Спасибо за шикарный сайт
Великолепный сайт на котором студент за не большие деньги может найти помощь с дз, проектами курсовыми, лабораторными, а также узнать отзывы на преподавателей и бесплатно скачать пособия.
Популярные преподаватели
Нашёл ошибку?
Или хочешь предложить что-то улучшить на этой странице? Напиши об этом и получи бонус!
Бонус рассчитывается индивидуально в каждом случае и может быть в виде баллов или бесплатной услуги от студизбы.
Предложить исправление
Добавляйте материалы
и зарабатывайте!
Продажи идут автоматически
5076
Авторов
на СтудИзбе
455
Средний доход
с одного платного файла
Обучение Подробнее