Двусвязный список. сортировка пузырьком.

type
  //Типы для описания списка.
 
  //Тип данных - определяет данные, которые будет содержать каждый элемент списка.
  TData = Integer;
  //Тип, описывающий элемент списка.
  TPElem = ^TElem;
  TElem = record
    Data : TData;
    PNext : TPElem;
    PPrev : TPElem;
  end;
  //Тип, описывающий список.
  TList = record
    PFirst : TPElem;
    PLast : TPElem;
  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 AddL(var aList : TList; const aPElem : TPElem);
begin
  if aPElem = nil then Exit;
 
  aPElem^.PNext := nil;
  aPElem^.PPrev := nil;
  if aList.PFirst = nil then
    aList.PFirst := aPElem
  else begin
    aList.PLast^.PNext := aPElem;
    aPElem^.PPrev := aList.PLast;
  end;
  aList.PLast := aPElem;
end;
 
//Распечатка списка.
function ListText(const aList : TList) : String;
var
  PElem : TPElem;
  i : Integer;
begin
  Result := '';
  i := 0;
  PElem := aList.PFirst;
  while PElem <> nil do begin
    Inc(i);
    if i > 1 then Result := Result + ', ';
    Result := Result + IntToStr(PElem^.Data);
    PElem := PElem^.PNext;
  end;
end;
 
//Пузырьковая сортировка по возрастанию.
procedure SortBubbleAsc(const aList : TList);
var
  P1, P2, P : TPElem;
  Data : TData;
  F : Boolean;
begin
  if aList.PFirst = aList.PLast then Exit;
 
  P := aList.PLast;
  repeat
    F := False;
 
    P1 := aList.PFirst;
    P2 := P1^.PNext;
    while P1 <> P do begin
      if P1^.Data > P2^.Data then begin
        Data := P1^.Data;
        P1^.Data := P2^.Data;
        P2^.Data := Data;
        F := True;
      end;
      P1 := P2;
      P2 := P1^.PNext;
    end;
 
    P := P^.PPrev;
  until not F;
end;
 
//Пузырьковая сортировка по убыванию.
procedure SortBubbleDesc(const aList : TList);
var
  P1, P2, P : TPElem;
  Data : TData;
  F : Boolean;
begin
  if aList.PFirst = aList.PLast then Exit;
 
  P := aList.PLast;
  repeat
    F := False;
 
    P1 := aList.PFirst;
    P2 := P1^.PNext;
    while P1 <> P do begin
      if P1^.Data < P2^.Data then begin
        Data := P1^.Data;
        P1^.Data := P2^.Data;
        P2^.Data := Data;
        F := True;
      end;
      P1 := P2;
      P2 := P1^.PNext;
    end;
 
    P := P^.PPrev;
  until not F;
end;
 
procedure TForm1.Button1Click(Sender: TObject);
var
  List : TList;
  PElem : TPElem;
  i : Integer;
begin
  //Инициализация списка.
  List.PFirst := nil;
  List.PLast := nil;
 
  //Создаём несколько элементов и помещаем их в список
  //через процедуру добавления в конец списка.
  Randomize;
  for i := 1 to 10 do begin
    New(PElem);
    PElem^.Data := Random(10); //0..9.
    AddL(List, PElem);
  end;
 
  //Показываем весь список в Мемо.
  Memo1.Lines.Add('--------------------------------------------------');
  Memo1.Lines.Add('Исходный список:');
  Memo1.Lines.Add(ListText(List));
 
  //Сортируем элементы по убыванию.
  SortBubbleDesc(List);
 
  //Показываем весь список в Мемо.
  Memo1.Lines.Add('Список после сортировки по убыванию (невозрастанию):');
  Memo1.Lines.Add(ListText(List));
 
  //Сортируем элементы по возрастанию.
  SortBubbleAsc(List);
 
  Memo1.Lines.Add('Список после сортировки по возрастанию (неубыванию):');
  Memo1.Lines.Add(ListText(List));
 
  //Удаление списка из памяти.
  ListFree(List);
end;