1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
| program Project1;
{$APPTYPE CONSOLE}
uses
SysUtils, Windows;
type
//Тип указателя на элемент списка.
TPElem = ^TElem;
//Тип элемента списка.
TElem = record
Data : String;
PNext : TPElem; //Указатель на следующий элемент списка.
end;
//Тип, описывающий однонаправленный список.
TList = record
PFirst : TPElem; //Указатель на первый элемент списка.
PLast : TPElem; //Указатель на последний элемент списка.
end;
//Начальная инициализация списка. Внимание! Эту процедуру можно выполнять
//только в отношении пустого списка! Иначе - будут утечки памяти.
procedure Init(var aList : TList);
begin
aList.PFirst := nil;
aList.PLast := nil;
end;
//Добавление элемента в конец однонаправленного списка.
procedure AddL(var aList : TList; const aPElem : TPElem);
begin
if aPElem = nil then Exit;
aPElem^.PNext := nil;
if aList.PFirst = nil then
aList.PFirst := aPElem
else
aList.PLast^.PNext := aPElem
;
aList.PLast := aPElem;
end;
(*
Исключение элемента из однонаправленного списка по указателю
на предыдущий элемент.
Функция возвращает указатель на элемент, который исключён из списка.
Если указатель на предыдущий элемент равен NIL, то исключается первый
элемент списка.
Эта функция только исключает элемент из списка. Если, кроме этого
требуется удалить элемент из памяти, тогда надо выполнить вызов
Dispose() за пределами процедуры.*)
function Del(var aList : TList; var aPPrev : TPElem) : TPElem;
begin
Result := nil;
if aList.PFirst = nil then Exit;
if aPPrev = nil then begin
Result := aList.PFirst;
aList.PFirst := Result^.PNext;
end else begin
Result := aPPrev^.PNext;
if Result <> nil then aPPrev^.PNext := Result^.PNext;
end;
if aList.PLast = Result then aList.PLast := aPPrev;
end;
//Удаление однонаправленного списка из памяти и инициализация.
procedure ListFree(var aList : TList);
var
PNext, PDel : TPElem;
begin
if aList.PFirst = nil then Exit;
PNext := aList.PFirst;
while PNext <> nil do begin
PDel := PNext;
PNext := PNext^.PNext;
Dispose(PDel);
end;
aList.PFirst := nil;
aList.PLast := nil;
end;
//Распечатка однонаправленного списка.
procedure ListPrint(const aList : TList);
var
PElem : TPElem;
i : Integer;
begin
if aList.PFirst = nil then begin
Writeln('Список пуст.');
Exit;
end;
PElem := aList.PFirst;
i := 0;
while PElem <> nil do begin
Inc(i);
if i > 1 then Write(', ');
Write(PElem^.Data);
PElem := PElem^.PNext;
end;
Writeln;
end;
var
L : TList;
PElem, PPrev, PDel : TPElem;
i : Integer;
S : String;
begin
//Переключение окна консоли на кодовую страницу CP1251 (Win-1251).
//Если после переключения русские буквы показываются неверно,
//следует открыть системное меню консольного окна - щелчком мыши в левом
//верхнем углу окна консоли и выбрать:
//Свойства - закладка "Шрифт" - выбрать шрифт: "Lucida Console".
SetConsoleCP(1251);
SetConsoleOutputCP(1251);
//Начальная инициализация списка.
Init(L);
repeat
//Создание списока.
Writeln('Создание списка.');
Writeln('Прекратить ввод - пустая строка + Enter.');
i := 0;
repeat
Write('Элемент ', i + 1, ': ');
Readln(S);
if S = '' then Continue;
Inc(i);
New(PElem);
PElem^.Data := S;
AddL(L, PElem);
until S = '';
Writeln('Составлен список:');
ListPrint(L);
Writeln('Задайте имя, которое следует удалить из списка:');
Readln(S);
//Удаляем из списка все элементы с заданным текстом.
PPrev := nil; //Указатель на предыдущий элемент.
PElem := L.PFirst; //Указатель на текущий элемент.
while PElem <> nil do begin
if PElem^.Data = S then begin //Удаление элемента и переход к следующему.
PDel := Del(L, PPrev);
PElem := PDel^.PNext;
Dispose(PDel);
end else begin //Переход к следующему элементу.
PPrev := PElem;
PElem := PElem^.PNext;
end;
end;
Writeln('Cписок после удаления:');
ListPrint(L);
//Удаление списка из памяти.
ListFree(L);
Writeln('Список удалён из памяти. Работа завершена.');
Writeln('Повторить - Enter. Выход - любой символ + Enter.');
Readln(S);
until S <> '';
end. |
(
