Program Stek;
uses
crt;
type
Tinf=integer;
List=^TList;
TList=record
data:TInf;
next:List;
end;
 
{процедура добавляющая элемент в стек}
procedure AddElem(var stek1:List;znach1:TInf);
var
tmp:List;
begin
GetMem(tmp,sizeof(TList));
tmp^.next:=stek1;
tmp^.data:=znach1;
stek1:=tmp;
end;
{Процедура вывода стека}
procedure Print(stek1:List);
begin
if stek1=nil then
begin
writeln('Стек пуст');
exit;
end;
while stek1<>nil do
begin
Write(stek1^.data, ' ');
stek1:=stek1^.next
end;
end;
 
{Процедура освобождения памяки занятой стеком}
Procedure FreeStek(stek1:List);
var
tmp:List;
begin
while stek1<>nil do
begin
tmp:=stek1;
stek1:=stek1^.next;
FreeMem(tmp,SizeOf(Tlist));
end;
end;
 
{Поиск элемента в стеке по значению}
Function SearchElemZnach(stek1:List;znach1:TInf):List;
begin
if stek1<>nil then
while (Stek1<>nil) and (znach1<>stek1^.data) do
stek1:=stek1^.next;
SearchElemZnach:=stek1;
end;
 
{Процедура удаления элемента по указателю}
Procedure DelElem(var stek1:List;tmp:List);
var
tmpi:List;
begin
if (stek1=nil) or (tmp=nil) then
exit;
if tmp=stek1 then
begin
stek1:=tmp^.next;
FreeMem(tmp,SizeOf(TList));
end
else
begin
tmpi:=stek1;
while tmpi^.next<>tmp do
tmpi:=tmpi^.next;
tmpi^.next:=tmp^.next;
FreeMem(tmp,sizeof(TList));
end;
end;
 
{Процедура удаления элемента по значению}
procedure DelElemZnach(var Stek1:List;znach1:TInf);
var
tmp:List;
begin
if Stek1=nil then
begin
Writeln('Стек пуст');
exit;
end;
tmp:=SearchElemZnach(stek1,znach1);
if tmp=nil then
begin
writeln('Элемент ',znach1, ' в стеке не найден');
exit;
end;
DelElem(stek1,tmp);
Writeln('Элемент удален');
end;
 
{Удаление элемента по порядковому номеру}
Procedure DelElemPos(var stek1:List;posi:integer);
var
i:integer;
tmp:List;
begin
if posi<1 then
exit;
if stek1=nil then
begin
Write('Стек пуст');
exit
end;
i:=1;
tmp:=stek1;
while (tmp<>nil) and (i<>posi) do
begin
tmp:=tmp^.next;
inc(i)
end;
if tmp=nil then
begin
Writeln('Искомая позиция элемента' ,posi, ' в стеке не найдена');
exit
end;
DelElem(stek1,tmp);
Writeln('Удаление произведено успешно');
end;
 
var
Stk, tmpl:List;
znach:Tinf;
ch:char;
begin
Stk:=nil;
repeat
clrscr;
Writeln('Выберите действие:');
Writeln('1 - Добавление элемента в стек');
Writeln('2 - Вывод содержимого стека');
Writeln('3 - Удаление элемента по значению');
Writeln('4 - Удаление элемента по позиции');
Writeln('5 - Поиск элемента в стеке');
Writeln('0 - Выход');
writeln;
readln(ch);
case ch of
'1':begin
write('Введите новый элемент');
readln(znach);
AddElem(Stk,znach);
end;
'2':begin
clrscr;
Print(Stk);
readkey;
end;
'3':begin
Write('Введите значение удаляемого элемента');
readln(znach);
DelElemZnach(Stk,znach);
readkey;
end;
'4':begin
Write('Введите номер удаляемого элемента');
readln(znach);
DelElemPos(Stk,znach);
readkey;
end;
'5':begin
write('Введите данные для поиска');
readln(znach);
tmpl:=SearchElemZnach(Stk,znach);
if tmpl=nil then
write('Искомый элемент не найден')
else
write('элемент ',tmpl^.data,' найден');
readkey;
end;
end;
until ch='0';
FreeStek(Stk);
end.