Составление и редактирование однонаправленых списков

program Project1;
 
{$N+} //Подключение математического сопроцессора. Это нужно для того, чтобы был доступен тип Extended.
 
type
  //Тип основных данных.
  TData = Extended;
  //Указатель на элемент списка.
  TPElem = ^TElem;
  //Элемент списка.
  TElem = record
    Data : TData; //Основные данные.
    PNext : TPElem; //Указатель на следующий элемент.
  end;
  //Список.
  TDList = record
    Cnt : Integer; //Количество элементов в списке.
    PFirst, PLast : TPElem; //Указатели на первый и на последний элементы списка.
  end;
 
//Процедура инициализации списка. Внимание! Эту процедуру можно выполнять
//только в отношении пустого списка. Иначе, произойдёт утечка памяти.
procedure Init(var aList : TDList);
begin
  aList.Cnt := 0;
  aList.PFirst := nil;
  aList.PLast := nil;
end;
 
//Добавление элемента в конец списка.
procedure Add(var aList : TDList; const aData : TData);
var
  PElem : TPElem;
begin
  New(PElem);
  PElem^.Data := aData;
  PElem^.PNext := nil;
  if aList.PFirst = nil then
    aList.PFirst := PElem
  else
    aList.PLast^.PNext := PElem;
  aList.PLast := PElem;
  Inc(aList.Cnt);
end;
 
//Освобождение памяти, занятой под список.
procedure ListFree(var aList : TDList);
var
  PElem, PDel : TPElem;
begin
  PElem := aList.PFirst;
  while PElem <> nil do begin
    PDel := PElem;
    PElem := PElem^.PNext;
    Dispose(PDel);
  end;
  Init(aList);
end;
 
//Распечатка всего списка.
procedure Print(var aList : TDList);
var
  PElem : TPElem;
  i : Integer;
begin
  PElem := aList.PFirst;
  i := 0;
  while PElem <> nil do begin
    Inc(i);
    if i > 1 then Write(', ');
    Write(PElem^.Data:0:5);
    PElem := PElem^.PNext;
  end;
  Writeln;
end;
 
//Добавление элемента после первого элемента с заданным значением.
//Функция возвращает позицию вставленного элемента в списке.
//Если элемент не вставлен в список, то функция возвращает значение равное нулю.
function InsertAfter(var aList : TDList; const aData, aDataIns : TData) : Integer;
var
  PElem, PIns : TPElem;
  Cnt : Integer;
  F : Boolean;
begin
  InsertAfter := 0;
  if aList.PFirst = nil then Exit;
 
  //Поиск первого элемента с заданным значением.
  PElem := aList.PFirst; //Указатель на текущий элемент.
  F := False; //True - элемент найден. Иначе - False.
  Cnt := 0; //Позиция текущего элемента в списке.
  while not F and (PElem <> nil) do begin
    Inc(Cnt);
    //Если текущий элемент имеет искомое значение. Значит искомый элемент найден.
    if PElem^.Data = aData then
      F := True
    //Если значение текущего элемента отличается от искомого, то продолжаем
    //поиск и переходим к следующему элементу.
    else
      PElem := PElem^.PNext;
  end;
 
  //Если элемент с заданным значением найден, то выполняем вставку.
  if F then begin
    //Создаём новый элемент.
    New(PIns);
    PIns^.Data := aDataIns;
    PIns^.PNext := nil;
    //Вставляем новый элемент.
    PIns^.PNext := PElem^.PNext;
    PElem^.PNext := PIns;
    //Если PElem был последним в списке, то теперь последним является PIns.
    if PElem = aList.PLast then aList.PLast := PIns;
  end;
 
  if F then
    InsertAfter := Cnt + 1
  else
    InsertAfter := 0;
end;
 
//Добавление элемента перед первым элементом с заданным значением.
//Функция возвращает позицию вставленного элемента в списке.
//Если элемент не вставлен в список, то функция возвращает значение равное нулю.
function InsertBefore(var aList : TDList; const aData, aDataIns : TData) : Integer;
var
  PElem, PPrev, PIns : TPElem;
  Cnt : Integer;
  F : Boolean;
begin
  InsertBefore := 0;
  if aList.PFirst = nil then Exit;
 
  //Поиск первого элемента с заданным значением.
  PPrev := nil; //Указатель на предыдущий элемент.
  PElem := aList.PFirst; //Указатель на текущий элемент.
  F := False; //True - элемент найден. Иначе - False.
  Cnt := 0; //Позиция текущего элемента в списке.
  while not F and (PElem <> nil) do begin
    Inc(Cnt);
    //Если текущий элемент имеет искомое значение. Значит искомый элемент найден.
    if PElem^.Data = aData then
      F := True
    //Если значение текущего элемента отличается от искомого, то продолжаем
    //поиск и переходим к следующему элементу.
    else begin
      PPrev := PElem;
      PElem := PElem^.PNext;
    end;
  end;
 
  //Если элемент с заданным значением найден, то выполняем вставку.
  if F then begin
    //Создаём новый элемент.
    New(PIns);
    PIns^.Data := aDataIns;
    PIns^.PNext := nil;
    //Вставляем новый элемент.
    PIns^.PNext := PElem;
    //Если найденный элемент был первым в списке, то теперь первым является PIns.
    if PElem = aList.PFirst then
      aList.PFirst := PIns
    else
      PPrev^.PNext := PIns;
  end;
 
  InsertBefore := Cnt;
end;
 
//Диалог для добавления элементов в конец списка.
procedure WorkAdd(var aList : TDList);
var
  S : String;
  Data : TData;
  Code : Integer;
begin
  Writeln('Добавление элементов в список.');
  Writeln('Ввод каждого значения завершайте нажатием Enter.');
  Writeln('Чтобы прекратить ввод оставьте пустую строку и нажмите Enter.');
  repeat
    Write('Элемент №', aList.Cnt + 1, ': ');
    Readln(S);
    if S = '' then begin
      Writeln('Элемент не добавлен.');
      Code := 0;
    end else begin
      Val(S, Data, Code);
      if Code = 0 then begin
        Add(aList, Data);
        Writeln('Элемент добавлен.');
        Code := 1;
      end else
        Writeln('Неверный ввод. Повторите.');
    end;
  until Code = 0;
  Writeln('Ввод элементов списка завершён.');
end;
 
var
  L : TDList;
  Data, DataIns : TData;
  Cmd, Code, Cnt, InsBa : Integer;
  S : String;
begin
  //Начальная инициализация списка.
  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('Содержимое списка:');
          Print(L);
        end;
      3:
        if L.PFirst = nil then
          Writeln('Список пуст.')
        else
          Writeln('Список не пуст.');
      4:
      begin
        Writeln('Вставка нового элемента до/после первого элемента с заданным значением.');
        repeat
          Write('Задайте значение искомого элемента: ');
          Readln(S);
          Val(S, Data, Code);
          if Code <> 0 then
            Writeln('Неверный ввод. Вы должны ввести целое число. Повторите.');
        until Code = 0;
        repeat
          Write('Задайте значение добавляемого элемента: ');
          Readln(S);
          Val(S, DataIns, Code);
          if Code <> 0 then
            Writeln('Неверный ввод. Вы должны ввести целое число. Повторите.');
        until Code = 0;
        repeat
          Write('Как добавить элемент до или после искомого? 1/2: ');
          Readln(S);
          Val(S, InsBa, Code);
          if (Code <> 0) or not (InsBa in [1, 2]) then begin
            Writeln('Неверный ввод. Вы должны ввести 1 или 2. Повторите.');
            Code := 1;
          end;
        until Code = 0;
        Write('Продолжить? д/н, y/n: ');
        Readln(S);
        if (S <> '') and (S[1] in ['Д', 'д', 'Y', 'y']) then begin
          if InsBa = 1 then
            Cnt := InsertBefore(L, Data, DataIns)
          else
            Cnt := InsertAfter(L, Data, DataIns);
          if Cnt > 0 then
            Writeln('Новый элемент вставлен в список. Его позиция в списке: ', Cnt)
          else
            Writeln('Искомый элемент не найден. Новый элемент в список не вставлен.');
        end else
          Writeln('Операция отменена.');
      end;
      5, 6:
      begin
        ListFree(L);
        Writeln('Список удалён из памяти (очищен).');
      end;
      else
        Writeln('Незарегистрированная команда. Повторите ввод.');
    end;
  until Cmd = 6;
 
  Writeln('Работа программы завершена. Для выхода нажмите Enter.');
  Readln;
end.