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; const N:integer);
var
PElem: TPElem;
I:integer;
begin
aL.PFirst := nil;
aL.PLast := nil;
for I := 1 to N do
begin
New(PElem);
PElem^.Data := random (100);
PElem^.PNext := nil;
{Если список пуст, то новый элемент становится единственным элементом списка.}
if aL.PFirst = nil then
aL.PFirst := PElem
{Если список непустой, то новый элемент прикрепляем за последним элементом списка.}
else
aL.PLast^.PNext := PElem;
aL.PLast := PElem;
end;
end;
{Добавление элемента в конец списка.}
procedure Insert(var aL : TDList; const aData : TData);
var
PElem : TPElem;
begin
New(PElem);
PElem^.Data := aData;
PElem^.PNext := aL.PFirst;
aL.PFirst := 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,0);
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 Remove(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;
Remove := Cnt; {Количество удалённых элементов.}
end;
function Search(var aL : TDList; const aData : TData ):integer;
var
PElem: TPElem;
position:integer;
begin
position:=1;
PElem:=aL.PFirst;
while PElem<>nil do
begin
if PElem.Data = aData then
begin
Search:=position;
Exit();
end
else
position:=position+1;
PElem:=PElem^.PNext;
end;
Search:=0;
end;
function Length(var aL : TDList):integer;
var
PElem: TPElem;
L:integer;
begin
L:=0;
PElem:=aL.PFirst;
while PElem<>nil do
begin
L:=L+1;
PElem:=Pelem^.PNext;
end;
Length:=L;
end;
var
L : TDList;
Data : TData;
Cmd, Code, Cnt,N : Integer;
S : String;
begin
repeat
{Меню.}
Writeln('Выберите действие:');
Writeln('1: Создать список');
Writeln('2: Распечатка всего списка.');
Writeln('3: Проверка списка на пустоту.');
Writeln('4: Удаление элементов по условию.');
Writeln('5: Очистка списка.');
Writeln('6: Последовательный поиск.');
Writeln('7: Длина списка.');
Writeln('8: Добавление элемента в конец списка');
Writeln('9: Выход.');
Write('Задайте команду: ');
Readln(Cmd);
case Cmd of
1:
begin
writeln('Введите количество элементов');
readln(N);
Create(L,N);
end;
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 := Remove(L, Data);
Writeln('Количество удалённых элементов: ', Cnt);
end
else
Writeln('Неверный ввод. Повторите.');
end;
until S = '';
Writeln('Диалог удаления завершён.')
end;
5, 9:
begin
Kill(L);
Writeln('Список удалён из памяти (очищен).');
if Cmd = 7 then
Writeln('Работа программы завершена.');
end;
6:
begin
Writeln('Последовательныц поиск. Введите элемент для поиска.');
Readln(S);
if S <> '' then
begin
Val(S, Data, Code);
if Code = 0 then
begin
Cnt := Search(L, Data);
Writeln('Позиция элемента(0-элемент не найден): ', Cnt);
end
else
Writeln('Неверный ввод. Повторите.');
end;
end;
7:
begin
Cnt := Length(L);
Writeln('Количество элементов списка: ', Cnt);;
end;
8:
begin
Writeln('Добавление элемента в список. Введите данные.');
Readln(S);
if S <> '' then
begin
Val(S, Data, Code);
if Code = 0 then
begin
Insert(L,Data);
end
else
Writeln('Неверный ввод. Повторите.');
end;
end;
else
Writeln('Незарегистрированная команда. Повторите ввод.');
end;
Writeln('Для продолжения нажмите Enter.');
Readln;
until Cmd = 9;
end.