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
| program Project1;
type
//Тип основных данных.
TData = Integer;
//Тип указателя на элемент списка.
TPElem = ^TElem;
//Тип элемента списка.
TElem = record
Data : TData; //Основные данные.
PNext : TPElem; //Указатель на следующий элемент списка.
end;
//Тип, описывающий однонаправленный список.
TList = record
PFirst, PLast : TPElem; //Указатели на первый и на последний элементы списка.
end;
//Начальная инициализация списка. Внимание! Эту процедуру можно выполнять
//только в отношении пустого списка! Иначе - будут утечки памяти.
procedure Init(var aList : TList);
begin
aList.PFirst := nil;
aList.PLast := nil;
end;
//Добавление элемента в конец однонаправленного списка.
procedure Add(var aList : TList; 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;
end;
//Удаление элемента из однонаправленного списка по указателю на предыдущий элемент.
//Если указатель на предыдущий элемент равен NIL, то удаляется первый элемент списка.
procedure Del(var aList : TList; var aPPrev : TPElem);
var
PDel : TPElem;
begin
if aList.PFirst = nil then Exit;
if aPPrev = nil then begin
PDel := aList.PFirst;
aList.PFirst := PDel^.PNext;
end else begin
PDel := aPPrev^.PNext;
if PDel <> nil then aPPrev^.PNext := PDel^.PNext;
end;
if aList.PLast = PDel then aList.PLast := aPPrev;
if PDel <> nil then Dispose(PDel);
end;
//Удаление однонаправленного списка из памяти и инициализация.
procedure Free(var aList : TList);
var
PNext, PDel : TPElem;
begin
PNext := aList.PFirst;
while PNext <> nil do begin
PDel := PNext;
PNext := PNext^.PNext;
Dispose(PDel);
end;
Init(aList);
end;
//Распечатка однонаправленного списка.
procedure Print(const aList : TList);
var
PElem : TPElem;
begin
if aList.PFirst = nil then begin
Writeln('Список пуст.');
Exit;
end;
PElem := aList.PFirst;
while PElem <> nil do begin
if PElem <> aList.PFirst then Write(', ');
Write(PElem^.Data);
PElem := PElem^.PNext;
end;
end;
var
L : TList;
PElem, PPrev : TPElem;
Data : TData;
i, Code : Integer;
S : String;
begin
//Начальная инициализация списка.
Init(L);
repeat
//Создание списока.
Writeln('Создание списка.');
Writeln('Прекратить ввод - пустая строка + Enter.');
i := 0;
repeat
Write('Элемент ', i + 1, ': ');
Readln(S);
if S <> '' then begin
Val(S, Data, Code);
if Code = 0 then begin
Inc(i);
Add(L, Data);
end else
Writeln('Неверный ввод. Повторите.');
end;
until S = '';
Writeln('Составлен список:');
Print(L);
Writeln;
//Находим в списке все элементы, значение которых кратно 3-ём.
//Распечатываем эти элементы и удаляем.
Writeln('Элементы, значения которых кратны 3-ём:');
i := 0;
PPrev := nil; //Указатель на предыдущий элемент.
PElem := L.PFirst; //Указатель на текущий элемент.
while PElem <> nil do begin
//Если элемент кратен 3-ём, то распечатываем этот элемент, удаляем
//и переходим к следующему.
if PElem^.Data mod 3 = 0 then begin
//Распечатка.
Inc(i);
if i > 1 then Write(', ');
Write(PElem^.Data);
//Удаление и переход к следующему.
Del(L, PPrev);
if PPrev <> nil then
PElem := PPrev^.PNext
else
PElem := L.PFirst;
//Если элемент не кратен 3-ём, то переходим к следующему элементу.
end else begin
PPrev := PElem;
PElem := PElem^.PNext;
end;
end;
if i = 0 then
Writeln('Нет ни одного элемента, кратного 3-ём.')
else
Writeln;
Writeln('Cписок после удаления элементов со значением, кратным 3-ём:');
Print(L);
Writeln;
//Удаление списка из памяти.
Free(L);
Writeln('Список удалён из памяти. Работа завершена.');
Writeln('Повторить - Enter. Выход - любой символ + Enter.');
Readln(S);
until S <> '';
end. |
(
Сообщение было отмечено Андрей 11 как решение
