Двунаправленные кольцевые списки

program Project1;
 
{$APPTYPE CONSOLE}
 
uses
  SysUtils, Windows;
 
type
  //Тип основных данных списка.
  TData = Integer;
  //Указатель на элемент списка.
  TPElem = ^TElem;
  //Элемент списка.
  TElem = record
    Data : TData; //Основные данные.
    PNext, PPrev : TPElem; //Указатели на следующий и на предыдущий элеметы списка.
  end;
  //Список.
  TDList = record
    Cnt : Integer;   //Количество элементов в списке.
    PFirst : TPElem; //Указатель на первый элемент списка.
  end;
 
//Процедуры для работы с двунаправленным кольцевым списоком.
 
//Процедура начальной инициализации. Внимание! Эту процедуру можно выполнять
//только в отношении пустого списка. Иначе, будут утечки памяти.
procedure Init(var aList : TDList);
begin
  aList.Cnt := 0;
  aList.PFirst := nil;
end;
 
//Освобождение памяти, занятой списком (очистка списка).
procedure ListFree(var aList : TDList);
var
  PElem, PDel : TPElem;
begin
  if aList.PFirst = nil then Exit;
 
  PElem := aList.PFirst;
  repeat
    PDel := PElem;
    PElem := PElem^.PNext;
    Dispose(PDel);
  until PElem = aList.PFirst;
  Init(aList);
end;
 
//Добавление элемента в начало двунаправленного кольцевого списка.
procedure AddF(var aList : TDList; const aData : TData);
var
  PElem : TPElem;
begin
  New(PElem);
  PElem^.Data := aData;
  if aList.PFirst = nil then begin //Если список пуст.
    PElem^.PNext := PElem; //Указатель на самого себя.
    PElem^.PPrev := PElem; //Указатель на самого себя.
  end else begin //Если список не пуст.
    PElem^.PNext := aList.PFirst;
    PElem^.PPrev := aList.PFirst^.PPrev;
    PElem^.PPrev^.PNext := PElem;
    PElem^.PNext^.PPrev := PElem;
  end;
  aList.PFirst := PElem;
  Inc(aList.Cnt);
end;
 
//Добавление элемента в конец двунаправленного кольцевого списка.
//Если список пуст, то новый элемент становится первым элементом списка.
//Если список не пуст, то новый элемент добавляется перед первым элементом списка.
procedure AddL(var aList : TDList; const aData : TData);
var
  PElem : TPElem;
begin
  New(PElem);
  PElem^.Data := aData;
  if aList.PFirst = nil then begin //Если список пуст.
    aList.PFirst := PElem;
    PElem^.PNext := PElem; //Указатель на самого себя.
    PElem^.PPrev := PElem; //Указатель на самого себя.
  end else begin //Если список не пуст.
    PElem^.PNext := aList.PFirst;
    PElem^.PPrev := aList.PFirst^.PPrev;
    PElem^.PPrev^.PNext := PElem;
    PElem^.PNext^.PPrev := PElem;
  end;
  Inc(aList.Cnt);
end;
 
//Диалог для добавления элементов в список.
procedure WorkAdd(var aList : TDList);
var
  S : String;
  Data : TData;
  Code : Integer;
begin
  Writeln('Ввод каждого значения завершайте нажатием Enter.');
  Writeln('Чтобы прекратить ввод, оставьте пустую строку и нажмите Enter.');
  repeat
    Write('Элемент №', aList.Cnt + 1, ': ');
    Readln(S);
    if S <> '' then begin
      Val(S, Data, Code);
      if Code = 0 then
        AddL(aList, Data)
      else
        Writeln('Неверный ввод. Повторите.');
    end;
  until S = '';
  Writeln('Ввод элементов списка завершён.');
end;
 
var
  L : TDList;
  PElem : TPElem;
  i, Cmd : Integer;
begin
  //Переключение окна консоли на кодовую страницу CP1251 (Win-1251).
  //Если после переключения русские буквы показываются неверно,
  //следует открыть системное меню консольного окна - щелчком мыши в левом
  //верхнем углу окна консоли и выбрать:
  //Свойства - закладка "Шрифт" - выбрать шрифт: "Lucida Console".
  SetConsoleCP(1251);
  SetConsoleOutputCP(1251);
 
  //Начальная инициализация списка.
  Init(L);
 
  repeat
    //Меню
    Writeln('Выберите действие:');
    Writeln('1: Добавление элементов в список.');
    Writeln('2: Перебор элементов в прямом направлении.');
    Writeln('3: Перебор элементов в обратном направлении.');
    Writeln('4: Сколько элементов в списке.');
    Writeln('5: Очистка списка.');
    Writeln('6: Выход.');
    Write('Введите команду: ');
    Readln(Cmd);
    case Cmd of
      1: WorkAdd(L);
      2:
        if L.PFirst = nil then
          Writeln('Список пуст')
        else begin
          Writeln('Перебор элементов в прямом направлении:');
          PElem := L.PFirst;
          i := 0;
          repeat
            Inc(i);
            if i > 1 then Write(', ');
            Write(PElem^.Data);
            PElem := PElem^.PNext;
          until PElem = L.PFirst;
          Writeln;
        end;
      3:
        if L.PFirst = nil then
          Writeln('Список пуст')
        else begin
          Writeln('Перебор элементов в обратном направлении:');
          PElem := L.PFirst;
          i := 0;
          repeat
            Inc(i);
            if i > 1 then Write(', ');
            Write(PElem^.Data);
            PElem := PElem^.PPrev;
          until PElem = L.PFirst;
          Writeln;
        end;
      4: Writeln('Количество элементов в списке: ', L.Cnt);
      5, 6:
      begin
        ListFree(L);
        Writeln('Память, занятая списком, освобождена (список очищен).');
      end;
      else
        Writeln('Незарегистрированная команда. Повторите ввод.');
    end;
  until Cmd = 6;
 
  Writeln('Работа программы завершена. Для выхода нажмите Enter.');
  Readln;
end.

        if L.PFirst = nil then
          Writeln('Список пуст')
        else begin
          Writeln('Перебор элементов в обратном направлении:');
          PElem := L.PFirst;
          i := 0;
          repeat
            Inc(i);
            if i > 1 then Write(', ');
            Write(PElem^.Data);
            PElem := PElem^.PPrev;
          until PElem = L.PFirst;
          Writeln;
        end;

        if L.PFirst = nil then
          Writeln('Список пуст')
        else begin
          Writeln('Перебор элементов в обратном направлении:');
          PElem := L.PFirst;
          i := 0;
          repeat
            Inc(i);
            if i > 1 then Write(', ');
            PElem := PElem^.PPrev;
            Write(PElem^.Data);
          until PElem = L.PFirst;
          Writeln;
        end;

      2:
        if L.PFirst = nil then
          Writeln('Список пуст')
        else begin
          Writeln('Перебор элементов в прямом направлении:');
          PElem := L.PFirst;
          i := 0;
          repeat
            Inc(i);
            if i > 1 then Write(', ');
            Write(PElem^.Data);
            PElem := PElem^.PNext;
          until PElem = L.PFirst;
          Writeln;
        end;
      3:
        if L.PFirst = nil then
          Writeln('Список пуст')
        else begin
          Writeln('Перебор элементов в обратном направлении:');
          PElem := L.PFirst;
          i := 0;
          repeat
            Inc(i);
            if i > 1 then Write(', ');
            Write(PElem^.Data);
            PElem := PElem^.PPrev;
          until PElem = L.PFirst;
          Writeln;
        end;

        if L.PFirst = nil then
          Writeln('Список пуст')
        else begin
          Writeln('Перебор элементов в обратном направлении:');
          PElem := L.PFirst;
          i := 0;
          repeat
            Inc(i);
            if i > 1 then Write(', ');
            Write(PElem^.Data);
            PElem := PElem^.PPrev;
          until PElem = L.PFirst;
          Writeln;
        end;

        if L.PFirst = nil then
          Writeln('Список пуст')
        else begin
          Writeln('Перебор элементов в обратном направлении:');
          PElem := L.PFirst;
          i := 0;
          repeat
            Inc(i);
            if i > 1 then Write(', ');
            PElem := PElem^.PPrev;
            Write(PElem^.Data);
          until PElem = L.PFirst;
          Writeln;
        end;