Удалить из стека элемент, расположенный в середине

program Project1;
 
type
  {Основные данные элемента стека.}
  TData = Char;
  {Указатель на элемент стека.}
  TPElem = ^TElem;
  {Элемент стека.}
  TElem = record
    Data : TData; {Основные данные.}
    PNext : TPElem; {Указатель на следующий элемент стека.}
  end;
  {Для стека отдельный тип можно не создавать. Стек будет представлен в виде
  указателя на тот элемент, который расположенный на вершине стека. Поэтому,
  переменная, представляющая стек, будет иметь тип TPElem.}
 
{Добавление элемента на вершину стека.}
procedure Push(var aPSt : TPElem; const aData : TData);
var
  PElem : TPElem;
begin
  New(PElem);
  PElem^.Data := aData;
  PElem^.PNext := aPSt;
  aPSt := PElem;
end;
 
{Изъятие элемента с вершины стека.
Если стек не пуст, то с вершины стека изымается элемент и его значение
(основные данные) возвращается через параметр aData. В этом случае, функция
возвращает значение True. Если стек пуст, то операция отменяется, и функция
возвращает значение False.}
function Pop(var aPSt : TPElem; var aData : TData) : Boolean;
var
  PElem : TPElem;
begin
  Pop := False;
  if aPSt = nil then
    Exit;
 
  PElem := aPSt;
  aPSt := PElem^.PNext;
  aData := PElem^.Data;
  Dispose(PElem);
  Pop := True;
end;
 
{Распечатка стека в направлении вершина - дно.}
procedure StWriteln(const aPSt : TPElem);
var
  PElem : TPElem;
begin
  PElem := aPSt;
  if PElem = nil then
    Write('Стек пуст.')
  else
    while PElem <> nil do
    begin
      if PElem <> aPSt then {Если это не первый элемент, то печатаем разделитель.}
        Write(', ');
      if PElem^.Data <= #32 then {Распечатываем код неотображаемого символа.}
        Write('#', Ord(PElem^.Data))
      else {Распечатка символа, который имеет графическое представление.}
        Write(PElem^.Data);
      PElem := PElem^.PNext; {Указатель на следующий элемент стека.}
    end;
  Writeln;
end;
 
{Освобождение памяти, занятой стеком (очистка стека).}
procedure StFree(var aPSt : TPElem);
var
  Data : TData;
begin
  while Pop(aPSt, Data) do;
end;
 
var
  PSt1, PSt2 : TPElem;
  Data : TData;
  i, Cnt : Integer;
  S : String;
begin
  {Начальная инициализация стеков.}
  PSt1 := nil;
  PSt2 := nil;
 
  repeat
    {Диалог ввода символов.}
    Writeln('Задайте символы.');
    Writeln('Чтобы прекратить ввод, оставьте пустую строку и нажмите Enter.');
    Cnt := 0;
    repeat
      Write('Элемент ', Cnt + 1, ': ');
      Readln(S);
      if S <> '' then
      begin
        Push(PSt1, S[1]);
        Inc(Cnt);
      end;
    until S = '';
    Writeln('Составлен стек (вершина - дно):');
    StWriteln(PSt1);
    Writeln('Количество элементов в стеке: ', Cnt);
 
    {Решение задачи.
    Будем переливать элементы из первого стека - во второй стек. При этом, когда
    встретится элемент, расположенный в середине - его мы во второй стек
    не станем добавлять. Таким образом он окажется удалённым. После переливания
    во втором стеке элементы окажутся в обратном порядке. Затем мы перельём
    элементы обратно: из второго стека - в первый стек. И порядок следования
    элементов вновь станет первоначальным.}
 
    {Удалять элемент в середине имеет смысл только, если количество элементов нечётное.}
    if Cnt mod 2 = 0 then
      Writeln('В стеке чётное количество элементов. Удаление отменено.')
    else
    begin
      {Переливаем элементы из первого стека - во второй стек. И выполняем
      удаление элемента в середине.}
      i := 0; {Счётчик элементов.}
      while Pop(PSt1, Data) do
      begin
        Inc(i);
        if i <> (Cnt div 2 + 1) then
          Push(PSt2, Data);
      end;
      {Переливаем элементы обратно: из второго стека - в первый стек.}
      while Pop(PSt2, Data) do
        Push(PSt1, Data);
      {Ответ.}
      Writeln('Стек после обработки (вершина - дно):');
      StWriteln(PSt1);
      Writeln('Был удалён элемент под номером: ', Cnt div 2 + 1);
    end;
 
    {Освобождаем память, занятую для элементов стеков.}
    StFree(PSt1);
    StFree(PSt2);
    Writeln('Память, выделенная для стеков, освобождена.');
 
    Writeln('Повторить - Enter. Выход - любой символ + Enter.');
    Readln(S);
  until S <> '';
end.