Извлечение элемента из очереди

Процедура извлечения элемента из очереди аналогична удалению элемента из начала списка. Поскольку извлечение элемента из пустой очереди осуществить нельзя, опишем логическую функцию, проверяющую, есть ли элементы в очереди.

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.