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
| implementation
{$R *.dfm}
type
{Тип основных данных.}
TData = Integer;
{Тип, описывающий указатель на элемент.}
TPElem = ^TElem;
{Тип, описывающий элемент списка.}
TElem = record
Data : TData;
PNext : TPElem; {Указатель на следующий элемент.}
end;
{Тип, описывающий список.}
TDList = record
PFirst, PLast : TPElem; {Указатели на первый и на последний элементы списка.}
end;
{Процедуры для работы со списком.}
{Начальная инициализация списка. Внимание! Эту процедуру можно выполнять
только в отношении пустого списка. Иначе будут утечки памяти.}
procedure Init(var aL : TDList);
begin
aL.PFirst := nil;
aL.PLast := nil;
end;
{Освобождение памяти, занятой для элементов списка и инициализация.}
procedure LFree(var aL : TDList);
var
P, PDel : TPElem;
begin
P := aL.PFirst; {Указатель на первый элемент списка.}
while P <> nil do
begin
PDel := P; {Запоминаем указатель на текущий элемент.}
P := P^.PNext; {Получаем указатель на следующий элемент.}
Dispose(PDel); {Освобождаем память, занятую текущим элементом списка.}
end;
Init(aL);
end;
{Добавление элемента в конец списка.}
procedure Add(var aL : TDList; const aData : TData);
var
P : TPElem;
begin
New(P); {Выделяем паямять для элемента.}
P^.Data := aData; {Записываем данные.}
{Так как добавляемый элемент будет последним в списке, то указатель
на следующий элемент делаем равным NIL.}
P^.PNext := nil;
{Если список пуст, то новый элемент станет первым элементом списка.}
if aL.PFirst = nil then
aL.PFirst := P
{Если список непустой, то новый элемент прикрепляем к последнему элементу списка.}
else
aL.PLast^.PNext := P;
{Новый элемент становится последним элементом списка.}
aL.PLast := P;
end;
{Пузырьковая сортировка по возрастанию.}
procedure SortDesc(const aL : TDList);
var
P, PEnd : TPElem;
Data : TData;
{F - флаг для пузырьковой сортировки. Показывает - была ли хотябы одна
перестановка элементов на текущей итерации (на текущем проходе области сортировки).}
F : Boolean;
begin
{Если список пуст или содержит только один элемент, то выходим.}
if aL.PFirst = aL.PLast then
Exit;
{Указатель на границу области сортировки. После прогона каждого пузырька
граница области сортировки смещается на 1 элемент в сторону начала списка.}
PEnd := aL.PLast;
repeat
F := False; {Начальное значение флага - перестановк не было.}
P := aL.PFirst; {Указатель на начало области сортировки.}
{Выполняем перебор, пока указатель не достиг конца области сортировки.
Во время перебора обрабатываем пары элементов P^ и P^.Next^. Сравниваем
их данные и, если требуется, выполняем перестановки.}
while P <> PEnd do
begin
{Если данные элемента больше данных следующего элемента, то выполняем перестановку.}
if P^.Data > P^.PNext^.Data then begin
Data := P^.Data;
P^.Data := P^.PNext^.Data;
P^.PNext^.Data := Data;
F := True; {Показываем, что произошла перестановка.}
end;
{Если обработана последняя пара (P^ и P^.Next^) в области сортировки, то
смещаем границу области сортировки на 1 элемент влево.}
if P^.PNext = PEnd then
PEnd := P
{Если это не последняя пара в области сортировки, то получаем указатель
на следующий элемент списка.}
else
P := P^.PNext;
end;
{Если на текущей итерации не было ни одной перестановки, значит сортировка завершена.}
until not F;
end;
{Распечатка списка.}
function ListToStr(const aL : TDList) : String;
var
P : TPElem;
begin
P := aL.PFirst; {Указатель на первый элемент списка.}
if P <> nil then
repeat
{Если это не первый элемент, то в распечатке ставим перед ним запятую.}
if P <> aL.PFirst then
Result := Result + ', ';
Result := Result + IntToStr(P^.Data); {Распечатываем данные текущего элемента.}
P := P^.PNext; {Получаем указатель на следующий элемент.}
until P = nil
else
Result := 'Список пуст.';
end;
procedure TForm1.Button1Click(Sender: TObject);
var
L : TDList;
i : Integer;
S : String;
begin
Init(L); //Начальная инициализация списка.
{Читаем числа из Мемо и добавляем их в список.
Предполагается, что каждое число в Мемо расположено на отдельной строке.}
for i := 0 to Memo1.Lines.Count - 1 do
begin
S := Memo1.Lines[i];
if S <> '' then
Add(L, StrToInt(S));
end;
Memo2.Lines.Add('--------------------------------------------------');
Memo2.Lines.Add('Составлен список:');
Memo2.Lines.Add(ListToStr(L));
SortDesc(L); //Сортировка списка по возрастанию.
Memo2.Lines.Add('Список после сортировки:');
Memo2.Lines.Add(ListToStr(L));
LFree(L); //Особождение памяти, занятой для элементов списка.
end;
end. |
(
