Входные данные:x1,y1, x2,y2- координаты сохраняемой части экрана,
выходные данные: uk-адрес памяти( где будет храниться рис)}
begin
razmer:=imagesize(x1,y1,x2,y2);
getmem(uk,razmer);{Отводим место в памяти под фрагмент}
getimage(x1,y1,x2,y2,uk^);
end;
procedure vstav(x1,y1:integer; uk:pointer);
{вставка рисунка из динамической памяти,
Входные данные:x1,y1 - координаты места вставки рисунка,
uk-адрес памяти( откуда будет взят рисунок)}
begin
putimage(x1,y1,uk^,0);
freemem(uk,razmer);
end;
procedure vvodint (var d:longint;x1,y1:integer);
{защищенный ввод числовой информации,
Входные данные: х,у-координаты на экране,
выходные данные: d-целое положительное число }
var
a:integer;{место ошибки }
ss:string;{для преобразования в число}
x2,y2:integer;{координаты закраски при неправильном вводе}
begin
repeat
setfillstyle(0,15);
if y1=8 then y2:=100; {координаты для бумаги(или числа заказов)}
if y1=11 then y2:=150; { координаты для фотореактивов}
bar(10,y2,250,y2+20) ; {закрашенный прямоугольник}
gotoxy(x1,y1);
readln(ss);
val(ss,d,a);
if a<>0 then
begin
outtextxy(x-35,185,'Повтори ввод');
delay(20000); {задержка}
setcolor(15);
outtextxy(x-35,185,'Повтори ввод');
setcolor(3);
end;
until (a=0) and (d>=0) ; {a-преобразование строки в число верно,
d- проверка на положительность числа}
end;
procedure izmenobs;
{изменение указателей недообслуженных фоторепортеров}
var
p:tl1list; {указатель на голову списка фоторепортеров}
begin
if (golova2<>nil ) then p:=golova2;
if (golova2<>nil ) and (p^.head<>nil) then
begin
p^.cur:=p^.head;
while (p^.cur<>nil) do
begin
p^.cur^.obs:=0;
p^.cur:=p^.cur^.next;
end;
p^.cur:=p^.head;
end;
end;
procedure popolnenie ;
{Изменение(создание) списка фирм, упорядоченного по алфавиту}
|
|
|
var
p:tl1list1;p2:tlink1; {Список фирм}
fl:boolean;{Флаг, указывающий, что искомый элемент не первый}
n1,n2:longint;{Параметры пополнения бумаги и реактивов}
nn:string[5];{Название фирмы}
y:char;{задержка информации на экране}
begin
setviewport(270,10,getmaxx-10,getmaxy-250,true);
Clearviewport; {табличка}
setfillstyle(1,8);
setlinestyle(0,0,3);
setcolor(3);
rectangle(0,0,358,209);
rectangle (4,4,354,205);
setcolor(3);
settextstyle(2,0,5);
p:=golova;
if golova=nil then
begin
new(p); {создание головы списка}
p^.head:=nil;
p^.predcur:=nil;
p^.cur:=nil;
golova:=p;
end;
settextstyle(2,0,5);
outtextxy(30,10 ,'Добавление фирмы:');
outtextxy(30,40 ,'Название фирмы:');
gotoxy(45,6);
readln(nn);
outtextxy(30,87 ,'Џ®Ї®«ҐЁҐ Ўг ЈЁ:');
gotoxy(45,8);
vvodint(n1,45,8);
z.bum:=z.bum+n1;
outtextxy(25,130 ,'Пополнение реактивов:');
gotoxy(45,11);
vvodint(n2,45,11);
setcolor(3);
settextstyle(2,0,5);
outtextxy(160,175,'Нажмите <Enter>: ');
y:=readkey;
z.rk:=z.rk+n2;
if p^.head=nil then
begin
new(p2); {первый элемент}
p2^.name:='';
p2^.next:=nil;
p^.head:=p2;
p^.cur:=p2;
p^.predcur:=p2;
p2^.name:=nn;
p2^.par1:=n1;
p2^.par2:=n2;
p2^.next:=nil;
end else
begin
p^.cur:=p^.head;
p^.predcur:=p^.head;
fl:=false;
while (nn>p^.cur^.name) and (p^.cur<>nil) do
begin
fl:=true;
p^.predcur:=p^.cur;
p^.cur:=p^.cur^.next; {Поиск места вставки}
|
|
|
end;
if nn=p^.cur^.name then
begin
p^.cur^.par1:=p^.cur^.par1+n1;
p^.cur^.par2:=p^.cur^.par2+n2; {Пополнение запасов}
end ;
if (fl=true) and (p^.cur<>nil)and (nn<>p^.cur^.name) then
begin
new(p2); {Вставка в середину перед}
p2^.name:=nn;
p2^.par1:=n1;
p2^.par2:=n2;
P2^.next:=P^.predcur^.next ;
p^.predcur^.next:=P2;
p^.cur:=p2;
end;
if (fl=true) and (p^.cur=nil)and (nn<>p^.cur^.name) then
begin
new(p2);
p2^.name:=nn; {В конец}
p2^.par1:=n1;
p2^.par2:=n2;
P2^.next:=nil ;
p^.predcur^.next:=P2;
p^.predcur:=p2;
p^.cur:=p2;
end;
if (fl=false) and (nn<>p^.cur^.name) then
begin
new(p2);
p2^.name:=nn;
p2^.par1:=n1;
p2^.par2:=n2;
p2^.next:=p^.cur; {Вставка в начало}
p^.cur:=p2;
p^.predcur:=p2;
p^.head:=p2;
end;
end;
izmenobs; {Изменение указателей недообслуженных
репортеров}
graphdefaults; {Полный экран}
end;
procedure udal1 ;
{Процедура удаления фирм из списка}
var
p:tl1list1;p2:tlink1; {Список фирм}
el:string;{Название фирмы}
flag:boolean;{Указывает, что элемент удален}
y:char;{ Задержка информации на экране}
begin
setviewport(270,10,getmaxx-10,getmaxy-250,true);
Clearviewport; {табличка}
|
|
|
setfillstyle(1,8);
setlinestyle(0,0,3);
setcolor(3);
rectangle(0,0,358,209);
rectangle (4,4,354,205);
setcolor(3);
settextstyle(2,0,5);
outtextxy(30,10 ,'Удаление фирмы:');
outtextxy(30,30 ,'Название фирмы:');
gotoxy(45,5);
readln(el);
flag:=false;
p:=golova;
p^.cur:=p^.head;
p^.predcur:=p^.head;
while (p^.cur<>nil) do
begin
if (p^.cur^.name=el) and (p^.cur=p^.head) then
begin
p^.head:=p^.cur^.next;
dispose(p^.cur); {Удаление первого элемента}
p^.predcur:=p^.head;
p^.cur:=p^.predcur;
flag:=true;
end else
if (p^.cur^.name=el) and (p^.cur<>p^.head) then
begin {Удаление из середины или из конца списка}
p^.predcur^.next:=p^.cur^.next;
dispose(p^.cur);
p^.cur:=p^.predcur^.next;
flag:=true;
end else
begin
p^.predcur:=p^.cur;
p^.cur:=p^.cur^.next;
end;
end;
if flag=false then
begin
settextstyle(2,0,5);
outtextxy(30,70 ,'Фирма отсутствует');
setcolor(3);
settextstyle(2,0,5);
outtextxy(130,150,'Нажмите <Enter>: ');
y:=readkey;
end;
graphdefaults; {Полный экран}
end;
Procedure prosmotr1;
{Процедура просмотра состояния списка фирм}
var
p:tl1list1;p2:tlink1; {Список фирм}
ss:string; {Для перевода числа в строку}
y1,k:integer; {y1 - Смещение координат на экране}
{k- число сообщений о фирмах на экране}
y:char; {Для задержки сообщения на экране}
begin
setviewport(270,10,getmaxx-10,getmaxy-250,true);
Clearviewport; {Табличка}
setfillstyle(1,8);
|
|
|
setlinestyle(0,0,3);
setcolor(3);
rectangle(0,0,358,209);
rectangle (4,4,354,205);
setcolor(3);
settextstyle(2,0,5);
p:=golova;
p^.cur:=p^.head;
p^.predcur:=p^.head;
ss:='';
y1:=0;
k:=0;
settextstyle(2,0,5);
outtextxy(30,10,'Просмотр фирм: ');
if (p^.head=nil) or (golova=nil) then
begin
setcolor(3);
settextstyle(2,0,5);
outtextxy(60,50,'Список пуст: ');
outtextxy(160,175,'Нажмите <Enter>: ');
y:=readkey;
end
else
begin
p2:=p^.head;
while (p2<>nil) do
begin
outtextxy(30,30+y1,'Фирма: ' +p2^.name);
str(p2^.par1,ss);
outtextxy(30,40+y1,'Бумага: '+ss);
str(p2^.par2,ss);
outtextxy(30,50+y1,'Реактивы: '+ss);
p2:=p2^.next;
k:=k+1;
y1:=y1+40;
setcolor(3);
settextstyle(2,0,5);
outtextxy(160,175,'Нажмите <Enter>: ');
y:=readkey;
if (k mod 4=0)then
begin
y1:=0;
Clearviewport; {Больше 4х элементов}
setlinestyle(0,0,3);
setcolor(3);
rectangle(0,0,358,209);
rectangle (4,4,354,205);
outtextxy(30,10,'Просмотр фирм: ');
end;
end;
Clearviewport; {Просмотрен весь список фирм}
setfillstyle(1,8);
setlinestyle(0,0,3);
setcolor(3);
rectangle(0,0,358,209);
rectangle (4,4,354,205);
setcolor(3);
settextstyle(2,0,5);
outtextxy(30,10,'Просмотрен весь список фирм: ');
outtextxy(30,150,'Нажмите <Enter>: ');
y:=readkey;
end;
graphdefaults; {Полный экран}
end;
procedure prosmotr2(i:byte);
{Просмотр списка репортеров на экране}
{Входные данные i - параметр вывода на экран
(если 1, то вывод осуществляется поэлементно)}
var
p:tl1list; p2:link; {Список репортеров}
k,t:integer;
{k - Смещение координаты на экране}
{t- Вывод на экран до 6 репортеров}
yy:char;{Задержка информации на экране}
begin
p:=golova2;
p^.cur:=p^.head;
k:=0;
t:=1;
fon;
if (P<>nil) and( p^.head<>nil) then
begin
p2:=p^.head;
while (p2<>nil) and (t<=6) do
begin
men(x+k,y-5,p2^.num,p2^.info,p2^.org);
k:=k+105;
p2:=p2^.next;
t:=t+1;
if i=1 then yy:=readkey;
end;
end;
yy:=readkey;
end;
procedure okno;
{Недоступны данные из файла}
var
y:char; {Задержка информации}
begin
setviewport(270,10,getmaxx-10,getmaxy-250,true); {окно }
Clearviewport; {табличка}
setfillstyle(1,8);
setlinestyle(0,0,3);
setcolor(3);
rectangle(0,0,358,209);
rectangle (4,4,354,205);
setcolor(3);
settextstyle(2,0,5);
outtextxy(30,10 ,'Данные из файла недоступны');
outtextxy(30,40 ,'Введите данные с клавиатуры');
outtextxy(30,80 ,'Для продолжения нажниме <Enter>');
y:=readkey;
graphdefaults; {полный экран}
fon;
end;
procedure izm2;
{Создание очереди фоторепортеров}
var
p:tl1list;{указатель на голову списка фоторепортеров}
p2:link;{указатель на элемент списка фоторепортеров}
nn:string;{организация}
n1:longint;{количество фотографий}
y:char;{задержка информации}
begin
setviewport(270,10,getmaxx-10,getmaxy-250,true); {окно }
Clearviewport; {табличка}
setfillstyle(1,8);
setlinestyle(0,0,3);
setcolor(3);
rectangle(0,0,358,209);
rectangle (4,4,354,205);
setcolor(3);
settextstyle(2,0,5);
outtextxy(30,10 ,'Список репортеров:');
p:=golova2;
z.rep:=z.rep+1;
if golova2=nil then
begin
new(p); {создание головы списка}
p^.head:=nil;
p^.posl:=nil;
p^.cur:=nil;
golova2:=p;
end;
settextstyle(2,0,5);
outtextxy(30,30 ,'Организация репортера:');
gotoxy(50,5);
readln(nn);
outtextxy(30,75 ,'Количество фотографий');
gotoxy(50,8);
vvodint(n1,50,8);
outtextxy(30,150,'Нажмите <Enter>: ');
y:=readkey;
if p^.head=nil then
begin
new(p2); { Первый элемент }
p2^.next:=nil;
p^.head:=p2;
p^.head^.prev:=nil;
p^.cur:=p2;
p^.posl:=p2;
p2^.org:=nn;
n:=n+1;
p2^.num:=n;
p2^.info:=n1;
p2^.obs:=0;
p2^.next:=nil;
end else
begin
new(p2); { Остальные элементы }
p2^.org:=nn;
p2^.info:=n1;
n:=n+1;
p2^.num:=n;
p2^.next:=nil;
p^.cur:=p^.posl;
p^.cur^.next:=p2;
p2^.prev:=p^.cur;
p^.posl:=p2;
end;
z.ft1:=z.ft1+p2^.info;
graphdefaults;
fon;
prosmotr2(0);
p^.cur:=p^.head;
cursor1:=p^.head;
end;
procedure pr;
{Просмотр списка фоторепортеров
(Использует процедуру Viv вывода порции информации) }
var
p:tl1list;{указатель на голову списка фоторепортеров}
p2:link; {указатель на элемент списка фоторепортеров}
m:integer; {приращение координат}
y:char;{служебная для задержки информации на экране}
ss:string; {для перевода числа в строку }
procedure Viv;
{вывод порции(3) информации о фоторепортерах}
begin {начало процедуры Viv(локальн.)}
Clearviewport;
setfillstyle(1,8);
setlinestyle(0,0,3);
setcolor(3);
rectangle(0,0,358,209);
rectangle (4,4,354,205);
m:=0;
outtextxy(30,10 ,'Просмотр очереди:');
if (p2<>nil) then
begin
str(p2^.num,ss);
outtextxy(30,30+m,'Номер в очереди: '+ss);
outtextxy(30,40+m,'Организация: '+ p2^.org);
str(p2^.info,ss);
outtextxy(30,50+m,'Кол-во фото: '+ss);
m:=m+40;
end;
if (p2<>nil) and(p2^.next<>nil) then
begin
str(p2^.next^.num,ss);
outtextxy(30,30+m,'Номер в очереди: '+ss);
outtextxy(30,40+m,'Организация: '+ p2^.next^.org);
str(p2^.next^.info,ss);
outtextxy(30,50+m,'Кол-во фото: '+ss);
m:=m+40;
end;
if (p2<>nil) and(p2^.next<>nil)and (p2^.next^.next<>nil) then
begin
str(p2^.next^.next^.num,ss);
outtextxy(30,30+m,'Номер в очереди: '+ss);
outtextxy(30,40+m,'Организация: '+ p2^.next^.next^.org);
str(p2^.next^.next^.info,ss);
outtextxy(30,50+m,'Кол-во фото: '+ss);
end;
p2:=p2^.next;
m:=m+40;
outtextxy(30,150 ,'Нажмите <Enter>');
y:=readkey;
end;{конец процедуры Viv(локальн.)}
begin {начало процедуры Pr}
setviewport(270,10,getmaxx-10,getmaxy-250,true);
Clearviewport; {табличка}
setfillstyle(1,8);
setlinestyle(0,0,3);
setcolor(3);
rectangle(0,0,358,209);
rectangle (4,4,354,205);
setcolor(3);
settextstyle(2,0,5);
outtextxy(30,10 ,'Просмотр очереди репортеров:');
p:=golova2;
p^.cur:=p^.head;
ss:='';
if (p^.cur=nil) or (golova2=nil)
then
begin
outtextxy(30,30 ,'Очередь пуста');
outtextxy(30,150 ,'Нажмите <Enter>');
y:=readkey;
end else if (p^.cur<>nil) then
begin
p2:=p^.head;
while (p2<>nil) do
begin
viv; {вывод порции информации}
end;
end;
graphdefaults; {полный экран}
end; {конец процедуры Pr}
procedure pros;
{Просмотр списка репортеров на экране в прямом направлении}
var
p:tl1list; p2:link; {Список репортеров}
k,t:integer;
cursor:link;
{k - Смещение координаты на экране}
{t- Вывод на экран до 6 репортеров}
yy:char;{Задержка информации на экране}
begin
if (cursor1^.next<>nil) and (cursor1{p^.head}<>nil) and (golova2<>nil) then
begin
k:=0;
t:=1;
fon;
cursor1:=cursor1^.next;
p2:=cursor1;
if (p2<>nil) and( p^.head<>nil)
then
while (p2<>nil) and (t<=6) do
begin
men(x+k,y-5,p2^.num,p2^.info,p2^.org);
k:=k+105;
p2:=p2^.next;
t:=t+1;
end;
end;
yy:=readkey;
end;
procedure pros1;
{Просмотр списка репортеров в обратном направлении на экране}
var
p:tl1list; p2:link; {Список репортеров}
k,t:integer;
{k - Смещение координаты на экране}
{t- Вывод на экран до 6 репортеров}
yy:char;{Задержка информации на экране}
begin
if (cursor1^.prev<>nil) and (p^.posl<>nil) and (p^.head<>nil)
and (golova2<>nil) and(cursor1<>nil)
then
begin
flag1:=true;
cursor1:=cursor1^.prev;
p2:=cursor1;
if (cursor1<>p^.head)then
begin
t:=1;
k:=0;
pam(0,getmaxy-256,getmaxx-105,getmaxy-132,ukaz1);
fon;
vstav(105, getmaxy-256,ukaz1);
men(x+k,y-5,p2^.num,p2^.info,p2^.org);
if (cursor1<>nil) and (cursor1=p^.head)then
begin
flag1:=false;
pam(0,getmaxy-256,getmaxx-105,getmaxy-132,ukaz1);
fon;
vstav(105, getmaxy-256,ukaz1);
men(x+k,y-5,p2^.num,p2^.info,p2^.org);
end;
end;
end;
yy:=readkey;
end;
procedure udalenie1;
{Удаление элемента(не первого) из списка фоторепортеров}
var
p:tl1list; {указатель на голову списка фоторепортеров}
p2:link; {указатель на элемент списка фоторепортеров}
pf:tl1list1; {указатель на голову списка фирм}
p2f:tlink1; {указатель на элемент списка фирм}
el:string; {организация}
begin
p:=golova2;
el:=p^.cur^.org;
z.rep:=z.rep-1;
z.rep1:=z.rep1+1;
begin
if (p^.cur^.org=el) and (p^.cur^.next=nil)
and (p^.cur<>p^.head) then {последний не один}
begin
P^.posl:=p^.cur^.prev;
p^.cur^.prev^.next:=nil;
dispose(p^.cur);
p^.cur:=p^.head;
end else
if (p^.cur^.org=el) and (p^.cur<>p^.head) and
(p^.cur^.next<>nil) then {не первый не последний}
begin
p^.cur^.prev^.next:=p^.cur^.next;
p^.cur^.next^.prev:=p^.cur^.prev;
p2:=p^.cur;
p^.cur:=p^.cur^.next;
dispose(p2);
end;
end;
end;
procedure udalenie;
{Удаление первого элемента из списка фоторепортеров}
var
p:tl1list; {указатель на голову списка фоторепортеров}
p2:link; {указатель на элемент списка фоторепортеров}
pf:tl1list1; {указатель на голову списка фирм}
p2f:tlink1;{указатель на элемент списка фирм}
el:string;{организация}
{nn:string;}
begin
p:=golova2;
z.rep:=z.rep-1;
z.rep1:=z.rep1+1;
el:=p^.cur^.org;
p^.cur:=p^.head;
if (p^.cur^.org=el) and (p^.cur^.next<>nil) and (p^.cur=p^.head) then
begin {голова списка - первый}
p^.head:=p^.cur^.next;
p^.head^.prev:=p^.cur^.prev;
if p^.cur<>nil then dispose(p^.cur);
p^.cur^.prev:=p^.head;
p^.cur:=p^.cur^.prev;
end else
if (p^.cur=p^.head) and (p^.cur^.next=nil)
and (p^.cur^.org=el) then {один элемент}
begin
if p^.cur<>nil then dispose(p^.cur);
p^.head:=nil;
p^.cur:=nil;
end;
end;
procedure obrabotka1;
{ обслуживание очереди(выбор фоторепортера из очереди, удаление элемента
списка, изменение данных о состояния запасов фотоматериалов)}
{Содержит процедуру obk-обслуживание обычных фоторепортеров}
var
p:tl1list; {указатель на голову списка фоторепортеров}
p2:link; {указатель на элемент списка фоторепортеров}
rn:integer; {разность значений фотоматериалов и реактивов}
flag,fl,ff:boolean;
{flag-признак, что нужно определить запасы общих фотоматериалов,
f1- признак, что нужно определить запасы фотоматериалов фирмы,
ff-признак, что в очереди не все папарацци}
pf:tl1list1; {указатель на голову списка фирм}
p2f:tlink1;{указатель на элемент списка фирм}
procedure obk;
{Обслуживание фоторепортеров}
begin {obk}
begin
rn:=pf^.cur^.par1-pf^.cur^.par2;
if (rn>=0) then {больше бумаги}
begin
if (pf^.cur^.par2>=p^.cur^.info)
and (p^.cur<>nil) then {реактивов больше заказов
фото}
begin
pf^.cur^.par2:=pf^.cur^.par2-p^.cur^.info;
pf^.cur^.par1:=pf^.cur^.par1-p^.cur^.info;
z.ft1:=z.ft1-p^.cur^.info;
z.rk:=z.rk-p^.cur^.info;
z.ft:=z.ft+p^.cur^.info;
z.bum:=z.bum-p^.cur^.info;
p^.cur^.info:=0;
if p^.cur=p^.head then
begin
udalenie; {удаление первого}
p^.cur:=P^.head;
end else
begin
udalenie1; {удаление не первого}
p^.cur:=P^.head;
end
end else
if (pf^.cur^.par2<p^.cur^.info)
and (p^.cur<>nil) then
begin {реактивов < заказов фото}
pf^.cur^.par1:=pf^.cur^.par1-p^.cur^.info ;
z.ft:=z.ft+p^.cur^.info;
z.bum:=z.bum-p^.cur^.info;
z.ft1:=z.ft1+p^.cur^.info;
z.rk:=z.rk-p^.cur^.info;
p^.cur^.obs:=1;
if pf^.cur^.par1<0 then pf^.cur^.par1:=0;
p^.cur^.info:=p^.cur^.info-pf^.cur^.par2;
z.ft1:=z.ft1-p^.cur^.info;
pf^.cur^.par2:=0;
end;
end;
if (rn<0) then
begin
if (pf^.cur^.par1>=p^.cur^.info)
and (p^.cur<>nil)then
begin
pf^.cur^.par1:=pf^.cur^.par1-p^.cur^.info;
pf^.cur^.par2:=pf^.cur^.par2-p^.cur^.info;
z.bum:=z.bum-p^.cur^.info;
z.rk:=z.rk-p^.cur^.info;
z.ft:=z.ft+p^.cur^.info;
z.ft1:=z.ft1-p^.cur^.info;
p^.cur^.info:=0;
if p^.cur=p^.head then
begin
udalenie; {удаление первого}
p^.cur:=P^.head;
end
else
begin
udalenie1; {удаление не первого}
p^.cur:=P^.head;
end
end else
if (pf^.cur^.par1< p^.cur^.info)
and (p^.cur<>nil) then
begin {бумаги <заказов фото}
pf^.cur^.par2:=pf^.cur^.par2-p^.cur^.info;
z.ft:=z.ft+p^.cur^.info;
z.rk:=z.rk-p^.cur^.info;
z.ft1:=z.ft1+p^.cur^.info;
p^.cur^.obs:=1;
if pf^.cur^.par2<0 then pf^.cur^.par2:=0;
p^.cur^.info:=p^.cur^.info-pf^.cur^.par1;
pf^.cur^.par1:=0;
z.bum:=z.bum-p^.cur^.info;
end;
end;
end;
end; {obk}
procedure ob1;
{поиск общих запасов}
begin
while (pf^.cur^.name <>'obk') and (pf^.cur<>nil) do
begin
pf^.predcur:=pf^.cur;
pf^.cur:=pf^.cur^.next;
end;
if (pf^.cur^.name ='obk') then obk;
end;
begin{obrabotka1}
p:=golova2;
pf:=golova;
rn:=0;
if (p^.head<>nil) and (golova2<>nil) then
begin
p^.cur:=p^.head;
while (p^.cur^.obs<>0) and (p^.cur<>nil) do
p^.cur:=p^.cur^.next;
if (p^.cur<>nil) then
begin
flag:=false;
fl:=false;
ff:=false;
if p^.cur^.org='pp' then
begin
while (p^.cur^.org='pp') and (p^.cur<>nil) do
begin {поиск не папарацци}
p^.cur:=p^.cur^.next;
if (p^.cur^.org<>'pp') and(p^.cur<>nil) then
ff:=true;
end;
if ff=false then
begin {все папарацци}
flag:=true;
p^.cur:=p^.head;
end
else flag:=false;
if flag=true then
begin
pf^.cur:=pf^.head;{поиск запасов для любого и обсл.}
ob1;
end
else {не папарацци}
begin
if (p^.cur^.org<>'pp') and (p^.cur^.org='obk')
and (p^.cur<>nil)
then
begin { обыкновенный}
pf^.cur:=pf^.head;
ob1; {поиск запасов и обсл.}
end
else
begin
if (p^.cur^.org<>'pp') and (p^.cur^.org<>'obk')
and (p^.cur<>nil)
then
begin { фоторепортер из фирмы }
pf^.cur:=pf^.head;
ob1; {поиск запасов для любого и обсл.}
end;
if (fl=true) and (p^.cur^.obs=1)then
begin { для недообсл. репортера фирмы}
pf^.cur:=pf^.head;
while (pf^.cur^.name<>p^.cur^.org) and
(pf^.cur^.next<>nil) do
begin {поиск запасов фирмы}
pf^.predcur:=pf^.cur;
pf^.cur:=pf^.cur^.next;
end;
if (pf^.cur^.name=p^.cur^.org) and
(pf^.cur^.next<>nil) then obk;
{ нашли и обсл.}
end;
end;
end;
end;
if (p^.cur^.org<>'pp') and (p^.cur^.org='obk')
and (p^.cur<>nil) then {первый в очереди обыкновенный}
begin
pf^.cur:=pf^.head;
ob1;
end else
if (p^.cur^.org<>'pp') and (p^.cur^.org<>'obk')
and (p^.cur<>nil) then
begin { первый в очереди из фирмы }
pf^.cur:=pf^.head;
ob1;
end;
if (fl=false)and (p^.cur<>nil) {and (p^.cur^.obs=1)}and
(p^.cur^.org<>'pp') and (p^.cur^.org<>'obk') then
begin
pf^.cur:=pf^.head;
while (pf^.cur^.name<>p^.cur^.org) and
(pf^.cur^.next<>nil) do
begin
pf^.predcur:=pf^.cur;
pf^.cur:=pf^.cur^.next;
end;
if (pf^.cur^.name=p^.cur^.org) and
(p^.cur<>nil) then obk;
end;
end;
prosmotr2(0);{вывод очереди на экран}
cursor1:=p^.head; {Начало очереди}
end;
end; {obrabotka1}
procedure fail;
{ввод данных из файла}
var f:text;
t:string[5]; {Название фирмы}
m:char;{Признак организации}
w,d:integer;
p:tl1list; {указатель на голову списка фоторепортеров}
p2:link; {указатель на элемент списка фоторепортеров}
rn:integer; {разность значений фотоматериалов и реактивов}
pf:tl1list1; {указатель на голову списка фирм}
pf2:tlink1;
i:integer;
fl:boolean;
begin
if flag2=true then
begin
assign(f,'firma.txt');
{$I-}
reset(f);
if ioresult<>0 then okno else
begin
{$I+}
p:=golova2;
if golova2=nil then
begin
new(p); {создание головы списка}
p^.head:=nil;
p^.posl:=nil;
p^.cur:=nil;
golova2:=p;
end;
i:=0;
while (m<>'0') do
begin {Создание списка репортеров}
readln(f,m,w,t);
i:=i+1;
if (p^.head=nil) and (m<>'0') then
begin
new(p2); { Первый элемент }
p2^.next:=nil;
p^.head:=p2;
p^.head^.prev:=nil;
p^.cur:=p2;
p^.posl:=p2;
delete(t,1,1); {удаляем первый пробел в названии фирмы}
p2^.org:=t;
p2^.num:=i;
p2^.info:=w;
p2^.obs:=0;
p2^.next:=nil;
end else if(p^.head<>nil) and (m<>'0') then
begin
new(p2);
delete(t,1,1); {Остальные элементы}
p2^.org:=t;
p2^.info:=w;
p2^.num:=i;
p2^.next:=nil;
p^.cur:=p^.posl;
p^.cur^.next:=p2;
p2^.prev:=p^.cur;
p^.posl:=p2;
end;
end;
i:=0;
while not eof(f) do
begin {Создание списка фирм}
readln(f,m,w,d,t);
i:=i+1;
pf:=golova;
if golova=nil then
begin
new(pf);
pf^.head:=nil;
pf^.predcur:=nil;
pf^.cur:=nil;
golova:=pf;
end;
if pf^.head=nil then
begin
new(pf2); {первый элемент}
{p2^.name:='';}
pf2^.next:=nil;
pf^.head:=pf2;
pf^.cur:=pf2;
pf^.predcur:=pf2;
delete(t,1,1);
pf2^.name:=t;
pf2^.par1:=w;
pf2^.par2:=d;
pf2^.next:=nil;
end else
begin
pf^.cur:=pf^.head;
pf^.predcur:=pf^.head;
fl:=false;
while (t>pf^.cur^.name) and (pf^.cur<>nil) do
begin
fl:=true;
pf^.predcur:=pf^.cur;
pf^.cur:=pf^.cur^.next; {Поиск места вставки}
end;
if t=pf^.cur^.name then
begin
pf^.cur^.par1:=pf^.cur^.par1+w;
pf^.cur^.par2:=pf^.cur^.par2+d;
{Пополнение запасов}
end ;
if (fl=true) and (pf^.cur<>nil)and (t<>pf^.cur^.name) then
begin
new(pf2);
delete(t,1,1); {Вставка в середину перед}
pf2^.name:=t;
pf2^.par1:=w;
pf2^.par2:=d;
Pf2^.next:=Pf^.predcur^.next ;
pf^.predcur^.next:=Pf2;
pf^.cur:=pf2;
end;
if (fl=true) and (pf^.cur=nil)and (t<>pf^.cur^.name) then
begin
new(pf2);
delete(t,1,1);
pf2^.name:=t; {в конец}
pf2^.par1:=w;
pf2^.par2:=d;
Pf2^.next:=nil ;
pf^.predcur^.next:=Pf2;
pf^.predcur:=pf2;
pf^.cur:=pf2;
end;
if (fl=false) and (t<>pf^.cur^.name) then
begin
new(pf2);
delete(t,1,1);
pf2^.name:=t;
pf2^.par1:=w;
pf2^.par2:=d;
pf2^.next:=pf^.cur; {Вставка в начало}
pf^.cur:=pf2;
pf^.predcur:=pf2;
pf^.head:=pf2;
end;
end;
end;
p^.cur:=p^.head;
fon;
prosmotr2(0); {вывод очереди на экран}
pf^.cur:=pf^.head;
cursor1:=p^.head;
close(f);
end;
flag2:=false;
end;
end;
procedure fail1;
{вывод данных из файла}
var f:text;
t:string[5]; {Название фирмы}
m:char;{Признак организации}
w,d:integer;
p:tl1list; {указатель на голову списка фоторепортеров}
p2:link; {указатель на элемент списка фоторепортеров}
rn:integer; {разность значений фотоматериалов и реактивов}
pf:tl1list1; {указатель на голову списка фирм}
pf2:tlink1;
i:integer;
fl:boolean;
begin
assign(f,'firma.txt');
rewrite(f);
p:=golova2;
if golova2<>nil then
begin
p2:=p^.head;
while p2<>nil do
begin
writeln(f,'r ', p2^.info,' ',p2^.org);
p2:=p2^.next;
end;
end;
writeln(f,'0',' ',0,' ','0');
pf:=golova;
if golova<>nil then
begin
pf2:=pf^.head;
while pf2<>nil do
begin
writeln(f,'f',' ', pf2^.par1,' ',pf2^.par1,' ',pf2^.name);
pf2:=pf2^.next;
end;
end;
close(f);
end;
begin
end.
unit ris; {Модуль графических изображений}
Interface
uses crt,graph,dan;
procedure zast;
procedure dom;
procedure men(x,y:integer;rep,k:integer;firma:string );
procedure fon;
implementation
procedure zast;
{ Заставка- сведения о курсовой работе}
begin
cleardevice;
setbkcolor(15);
setlinestyle(0,0,1);
setcolor(5);
setfillstyle(7,11); {7-штриховка}
rectangle(0,0,getmaxx,getmaxy);setfillstyle(7,11);
{7-штриховка}
rectangle(0,0,getmaxx,getmaxy);
rectangle(10,10,getmaxx-10,getmaxy-10);
floodfill(x+23,y+21,5);
settextstyle(1,0,2);
outtextxy(200,60 ,'КУРСОВАЯ РАБОТА ');
outtextxy(100,100 ,'по дисциплине: "ПРОГРАММИРОВАНИЕ" ');
outtextxy(70,140 ,'Тема: "Моделирование работы фотоателье"');
settextstyle(2,0,6);
outtextxy(250,240 ,'Выполнил:студент группы 2351 ');
outtextxy(350,260 ,'Иванов И.И. ');
settextstyle(0,0,1);
outtextxy(100,400 ,' для продолжения нажмите <Enter>');
f:=readkey;
end;
procedure dom;{рисует домик-фотоателье}
begin
setlinestyle(0,0,1);
setcolor(5);
rectangle(40,getmaxy-190-y,100,getmaxy-110-y);{лицевая стена}
line(100,getmaxy-110-y,140,getmaxy-150-y); {боковая стена}
line(30,getmaxy-190-y,110,getmaxy-190-y);
line(30,getmaxy-190-y,70,getmaxy-245-y);
line(70,getmaxy-245-y,110,getmaxy-190-y);
setcolor(5);
line(110,getmaxy-190-y,150,getmaxy-230-y); {крыша}
line(140,getmaxy-220-y,140,getmaxy-150-y);
line(70,getmaxy-245-y,110,getmaxy-280-y);
line(110,getmaxy-280-y,150,getmaxy-230-y);
setfillstyle(1,4);
floodfill(100,getmaxy-250-y,5);
setfillstyle(1,7);
floodfill(50,getmaxy-200-y,5);
floodfill(50,getmaxy-150-y,5);
setfillstyle(1,8);
floodfill(110,getmaxy-150-y,5);
setcolor(11);
rectangle(55,getmaxy-170-y,85,getmaxy-135-y); {окно}
setfillstyle(1,8);
floodfill(70,getmaxy-150-y,11);
line(70,getmaxy-170-y,70,getmaxy-135-y);
line (55,getmaxy-157-y,85,getmaxy-157-y);
setcolor(7);
line(122,getmaxy-185-y,122,getmaxy-145-y); {дверь}
line (135,getmaxy-200-y,135,getmaxy-158-y);
line(122,getmaxy-185-y,135,getmaxy-200-y);
line (122,getmaxy-145-y,135,getmaxy-158-y);
setfillstyle(1,6);
floodfill(130,getmaxy-190-y,7);
line(125,getmaxy-173-y,125,getmaxy-170-y);
setcolor(11);
arc(70,getmaxy-205-y,0,180,14); {чердачное окно}
line(56,getmaxy-205-y,84,getmaxy-205-y);
setfillstyle(1,8);
floodfill(70,getmaxy-208-y,11);
setcolor(14);
settextstyle(2,0,5);
outtextxy(55, getmaxy-187-y,'ФОТО'); {надпись фото}
end;
procedure men(x,y:integer;rep,k:integer;firma:string );
{рисунок репортера,
входные данные:
Дата добавления: 2018-06-27; просмотров: 349; Мы поможем в написании вашей работы! |
Мы поможем в написании ваших работ!