2015-05-30
702
Процедура извлечения элемента из очереди аналогична удалению элемента из начала списка. Поскольку извлечение элемента из пустой очереди осуществить нельзя, опишем логическую функцию, проверяющую, есть ли элементы в очереди.
Procedure readO(Var BeginO, EndO: EXO; Var c: integer);
Var
u: EXO;
Function FreeO(x1: EXO): boolean;
Begin
FreeO:= (x1=Nil);
End;
Begin
if FreeO(BeginO)
then
writeln('Очередь пуста');
else
begin
c:= BeginO^.Data; {считываем искомое значение в переменную с}
u:= BeginO; {ставим промежуточный указатель на первый элемент очереди}
BeginO:= BeginO^.Next;{указатель начала переносим на следующий элемент}
dispose(u); {освобождаем память, занятую уже ненужным первым элементом}
end;
End;
Задание. Напишите программу, содержащую все необходимые процедуры и функции работы с очередью.
Задание. Чтобы наглядно рассмотреть работу очереди, наберите следующую программу.
Program Demidenko;
Uses
Crt, Graph;
Type
sp=^spis;
spis=record
elem: byte;
next: sp;
End;
Var
a,
b: byte;
s: string;
gd, gm, c: integer;
head, some, x: sp;
bol: boolean;
ch: char;
Procedure OutHead(x, y: integer);
Begin
Line(x+20,y+35,x+20,y+20);
Line(x+20,y+20,x+17,y+25);
Line(x+20,y+20,x+23,y+25);
|
|
|
Line(x+23,y+25,x+17,y+25);
OutTextXY(x+6, y+38, 'head');
End;
Procedure OutX(x, y: integer);
Begin
Line(x+40,y-15,x+40,y);
Line(x+40,y,x+37,y-5);
Line(x+40,y,x+43,y-5);
Line(x+43,y-5,x+37,y-5);
OutTextXY(x+28,y-25,'x');
End;
Procedure wiv(x,y:integer;ss:sp);
Begin
Line(x,y,x+50,y);
Line(x,y,x,y+20);
Line(x,y+20,x+50,y+20);
Line(x+50,y,x+50,y+20);
Line(x+30,y,x+30,y+20);
if some=ss
then
Begin
Line(x+40,y-15,x+40,y);
Line(x+40,y,x+37,y-5);
Line(x+40,y,x+43,y-5);
Line(x+43,y-5,x+37,y-5);
OutTextXY(x+28,y-25,'tail');
End;
if ss^.elem<255
then
Begin
str(ss^.elem,s);
outtextxy(x+10,y+10,s);
End;
if ss^.next<>nil
then
Begin
Line(x+40,y+10,x+60,y+10);
Line(x+60,y+10,x+60,y-10);
Line(x+60,y-10,x+100,y-10);
Line(x+100,y-10,x+100,y);
Line(x+100,y,x+97,y-5);
Line(x+100,y,x+103,y-5);
Line(x+103,y-5,x+97,y-5);
Wiv(x+70, y, ss^.next);
End
else
Begin
Line(x+40,y+10,x+40,y+30);
Line(x+40,y+30,x+37,y+25);
Line(x+40,y+30,x+43,y+25);
Line(x+43,y+25,x+37,y+25);
Line(x+35,y+32,x+45,y+32);
Line(x+36,y+35,x+44,y+35);
Line(x+38,y+38,x+42,y+38);
End;
End;
Procedure InsertOch(x: byte);
Begin
Cleardevice;
OutTextXY(50,20,'NEW(SOME^.NEXT)');
new(some^.next);
some^.next^.next:=nil;
some^.next^.elem:=255;
Wiv(20,100,head^.next);
OutHead(20,100);
Delay(1000);
Cleardevice;
OutTextXY(50,20,'SOME:=SOME^.NEXT');
some:= some^.next;
some^.next:= nil;
Wiv(20,100,head^.next);
OutHead(20,100);
Delay(1000);
Cleardevice;
Outtextxy(50,20,'SOME^.NEXT:=NIL');
Str(x,s);
OutTextXY(50,40,'SOME^.ELEM:='+s);
some^.elem:= x;
Wiv(20,100,head^.next);
OutHead(20,100);
Delay(1000);
end;
Procedure DelOch;
Begin
Cleardevice;
if head^.next^.elem=255
then
Begin
OutTextXY(50,20,'Элемент не существует!');
Delay(1000);
End
else
if head^.next^.next<>nil
then
Begin
OutTextXY(50,20,'X:=HEAD');
OutTextXY(50,40,'HEAD:=HEAD^.NEXT');
Wiv(20,100,head^.next);
OutX(15,100);
OutHead(90,100);
Delay(1000);
Cleardevice;
OutTextXY(50,20,'DISPOSE(X)');
Wiv(20,100,head^.next);
OutX(20,100);
OutHead(90,100);
Setcolor(red);
Line(20,90,70,130);
Line(70,90,20,130);
Setcolor(white);
Delay(1000);
Cleardevice;
head:=head^.next;
Wiv(20,100,head^.next);
OutHead(20,100);
End
else
Begin
OutTextXY(50,20,'DISPOSE(HEAD)');
Wiv(20,100,head^.next);
OutHead(20,100);
setcolor(red);
Line(20,90,70,130);
Line(70,90,20,130);
setcolor(white);
delay(1000);
cleardevice;
OutHead(20,100);
head^.next^.elem:=255;
some:=head;
End;
End;
Begin
TextBackGround(black);
ClrScr;
bol:=false;
gD:= Detect;
InitGraph(gD, gM,'c:\tp7\bgi\');
new(head);
some:=head;
some^.next:=nil;
Repeat
OutTextXY(50,200,'1 * Добавить элемент');
|
|
|
OutTextXY(50,220,'2 * Удалить элемент');
OutTextXY(50,240,'Esc Выход');
ch:=readkey;
case ch of
'1': Begin
OutTextXY(50,260,'Введите число:');
Gotoxy(23,17);
readln(b);
InsertOch(b);
End;
'2': DelOch;
#27: Begin
CloseGraph;
Halt;
End;
End;
until bol;
CloseGraph;
End.
