В результате выполнения этой операции некоторой переменной i должно быть присвоено значение первого элемента стека и значение указателя на начало списка должно быть перенесено на следующий элемент стека.
Procedure readStack(Var u: EXST; Var i: integer);
Var
x: EXST;
Begin
i:= u^.Data; {считываем значение поля данных в переменную}
x:= u; {запоминаем адрес вершины стека}
u:= u^.Next; {переносим вершину стека на следующий элемент}
dispose(x); {освобождаем память, занятую уже ненужным элементом стека}
End.
Недостатком описанной процедуры является предположение о том, что стек не пуст. Для его исправления следует разработать логическую функцию проверки пустоты обрабатываемого стека.
Function FreeStack(u: EXST): boolean;
Задание. Описать функцию и закончить программу, для чего описать процедуру вывода значений элементов стека на экран (она аналогична выводу списка). Протестировать программу, дополнить комментарием и показать файл и листинг учителю для оценки.
Чтобы наглядно рассмотреть работу стека, наберите следующую программу.
|
|
Program Demidenko;
Uses
Crt, Graph;
Type
sp=^spis;
ecord
elem: byte;
next: sp;
End;
Var
a, b: byte;
s: string;
gd, gm, c: integer;
head, some, x: sp;
bol: boolean;
ch: char;
Procedure OutX(x, y: integer);
Begin
Line(x+50,y+10,x+70,y+10);
Line(x+50,y+10,x+55,y+10-3);
Line(x+50,y+10,x+55,y+10+3);
Line(x+55,y+13,x+55,y+10-3);
OutTextXY(x+70,y+10,'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+50,y+10,x+70,y+10);
Line(x+50,y+10,x+55,y+10-3);
Line(x+50,y+10,x+55,y+10+3);
Line(x+55,y+13,x+55,y+10-3); End;
Str(ss^.elem, s);
OutTextXY(x+10,y+10,s);
if (ss^.next<>nil)
then
Begin
Line(x+40,y+10,x+40,y+40);
Line(x+40,y+40,x+37,y+40-5);
Line(x+40,y+40,x+43,y+40-5);
Line(x+43,y+40-5,x+37,y+40-5);
Wiv(x,y+40,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 Insertsp(x: byte);
Begin
Cleardevice;
OutTextXY(50,20,'NEW(X)');
new(some);
Line(20,100,20+50,100);
Line(20,100,20,100+20);
Line(20,100+20,20+50,100+20);
Line(20+50,100,20+50,100+20);
Line(20+30,100,20+30,100+20);
Outx(20,100);
if head<>nil
then
Wiv(20,140,head);
Delay(1000);
Cleardevice;
OutTextXY(50,20,'X^.NEXT:=TAIL');
OutTextXY(50,40,'TAIL:=X');
some^.next:=head;
head:=some;
Wiv(20,100,head);
Delay(1000);
Cleardevice;
Str(x,s);
OutTextXY(50,20,'SOME^.ELEM:='+s);
some^.elem:=x;
Wiv(20,100,head);
Delay(1000);
End;
Procedure DelSp;
Begin
Cleardevice;
if head=nil
then
Begin
Y(50,20,'Элемент не существует!');
Delay(1000);
End
else
if head^.next<>nil
then
Begin
OutTextXY(50,20,'X:=TAIL');
OutTextXY(50,40,'TAIL:=TAIL^.NEXT');
some:=some^.next;
Wiv(20,100,head);
OutX(20,100);
Delay(1000);
Cleardevice;
OutTextXY(50,20,'DISPOSE(X)');
Wiv(20,100,head);
OutX(20,100);
Setcolor(red);
Line(20,90,70,130);
Line(70,90,20,130);
Setcolor(white);
Delay(1000);
Cleardevice;
head:=head^.next;
some:=head;
Wiv(20,100,head);
End
else
Begin
OutTextXY(50,20,'DISPOSE(TAIL)');
Wiv(20,100,head);
Setcolor(red);
Line(20,90,70,130);
Line(70,90,20,130);
Setcolor(white);
Delay(1000);
ClearDevice;
head:=nil;
some:=head;
End;
End;
Begin
ClrScr;
bol:=false;
gD:= Detect;
InitGraph(gD, gM,'c:\tp7\bgi\');
TextBackGround(black);
Setbkcolor(black);
Head:=nil;
Some:=head;
Repeat
OutTextXY(250,200,'1 * Добавить элемент');
OutTextXY(250,220,'2 * Удалить элемент');
|
|
OutTextXY(250,240,'Esc Выход');
ch:=readkey;
case ch of
'1': Begin
OutTextXY(250,260,'Введите число:');
gotoxy(48,17);
readln(b);
InsertSp(b);
End;
'2': delsp;
#27: Begin
CloseGraph;
Halt;
End;
End;
until bol;
CloseGraph;
End.