program Project1;
type
{Тип основных данных.}
TData = Integer;
{Указатель на элемент списка.}
TPElem = ^TElem;
{Элемент списка.}
TElem = record
Data : TData; {Основные данные.}
PNext : TPElem; {Указатель на следующий элемент.}
end;
{Список.}
TDList = record
PFirst, PLast : TPElem; {Указатели на первый и на последний элементы списка.}
end;
{Процедура инициализации списка. Внимание! Эту процедуру можно выполнять
только в отношении пустого списка. Иначе, произойдёт утечка памяти.}
procedure Create(var aL : TDList);
begin
aL.PFirst := nil;
aL.PLast := nil;
end;
{Добавление элемента в конец списка.}
procedure Insert(var aL : TDList; const aData : TData);
var
PElem : TPElem;
begin
New(PElem);
PElem^.Data := aData;
PElem^.PNext := nil;
{Если список пуст, то новый элемент становится единственным элементом списка.}
if aL.PFirst = nil then
aL.PFirst := PElem
{Если список непустой, то новый элемент прикрепляем за последним элементом списка.}
else
aL.PLast^.PNext := PElem;
aL.PLast := PElem; {Новый элемент становится последним элементом списка.}
end;
{Освобождение памяти, занятой под список.}
procedure Kill(var aL : TDList);
var
PElem, PDel : TPElem;
begin
PElem := aL.PFirst; {Указатель на первый элемент списка.}
while PElem <> nil do
begin
PDel := PElem; {Указатель на удаляемый элемент.}
PElem := PElem^.PNext; {Указатель на следующий элемент списка.}
Dispose(PDel); {Освобождение памяти, занятой под удаляемый элемент.}
end;
Create(aL);
end;
{Распечатка всего списка.}
procedure LWriteln(var aL : TDList);
var
PElem : TPElem;
begin
PElem := aL.PFirst; {Указатель на первый элемент списка.}
if PElem = nil then
Write('Список пуст.')
else
while PElem <> nil do
begin
if PElem <> aL.PFirst then
Write(', ');
Write(PElem^.Data);
PElem := PElem^.PNext; {Указатель на следующий элемент списка.}
end;
Writeln;
end;
{Удаление из списка элементов с заданным значением.}
function DelByVal(var aL : TDList; const aData : TData) : Integer;
var
PElem, PPrev, PDel : TPElem;
Cnt : Integer;
begin
Cnt := 0; {Счётчик удалённых элементов.}
PPrev := nil; {Указатель на предыдущий элемент.}
PElem := aL.PFirst; {Указатель на текущий элемент.}
while PElem <> nil do
if PElem^.Data = aData then {Если обнаружен элемент, который требуется удалить.}
begin
{Если удаляемый элемент является первым элементом списка, то первым
элементом списка назначаем следующий элемент.}
if PElem = aL.PFirst then
aL.PFirst := PElem^.PNext
{Если удаляемый элемент не является первым элементом списка, то поле
PNext предыдущего элемента теперь должно указывать на элемент, который
является следующим относительно PElem.}
else
PPrev^.PNext := PElem^.PNext;
{Если удаляемый элемент является последним элементом списка, то последним
элементом списка назначаем предыдущий элемент.}
if PElem = aL.PLast then
aL.PLast := PPrev;
PDel := PElem; {Указатель на удаляемый элемент.}
PElem := PElem^.PNext; {Указатель на следующий элемент.}
Dispose(PDel); {Освобождение памяти, занятой под элемент.}
Inc(Cnt); {Подсчитываем удалённый элемент.}
end
else {Переход к следующему элементу списка.}
begin
PPrev := PElem;
PElem := PElem^.PNext;
end;
DelByVal := Cnt; {Количество удалённых элементов.}
end;
{Диалог добавления элементов в список.}
procedure WorkAdd(var aL : TDList);
var
S : String;
PElem : TPElem;
Data : TData;
Code, Cnt : Integer;
begin
{Подсчёт количества элементов в списке.}
Cnt := 0;
PElem := aL.PFirst;
while PElem <> nil do
begin
Inc(Cnt);
PElem := PElem^.PNext;
end;
Writeln('Добавление элементов в список.');
Writeln('Ввод каждого значения завершайте нажатием Enter.');
Writeln('Чтобы прекратить ввод, оставьте пустую строку и нажмите Enter.');
repeat
Write('Элемент №', Cnt + 1, ': ');
Readln(S);
if S <> '' then
begin
Val(S, Data, Code);
if Code = 0 then
begin
Insert(aL, Data);
Inc(Cnt);
end
else
Writeln('Неверный ввод. Повторите.');
end;
until S = '';
Writeln('Ввод элементов списка завершён.');
end;
var
L : TDList;
Data : TData;
Cmd, Code, Cnt : Integer;
S : String;
begin
{Начальная инициализация списка.}
Create(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:
begin
Writeln('Содержимое списка:');
LWriteln(L);
end;
3:
if L.PFirst = nil then
Writeln('Список пуст.')
else
Writeln('Список непустой.');
4:
begin
Writeln('Элементы с заданным значением будут удалены из списка.');
Writeln('Чтобы отменить операцию оставьте пустую строку и нажмите Enter.');
repeat
Write('Значение: ');
Readln(S);
if S <> '' then
begin
Val(S, Data, Code);
if Code = 0 then
begin
Cnt := DelByVal(L, Data);
Writeln('Количество удалённых элементов: ', Cnt);
end
else
Writeln('Неверный ввод. Повторите.');
end;
until S = '';
Writeln('Диалог удаления завершён.')
end;
5, 6:
begin
Kill(L);
Writeln('Список удалён из памяти (очищен).');
if Cmd = 6 then
Writeln('Работа программы завершена.');
end;
else
Writeln('Незарегистрированная команда. Повторите ввод.');
end;
Writeln('Для продолжения нажмите Enter.');
Readln;
until Cmd = 6;
end.