Линейные списки - Delphi - Ответ 3265429

type
  //Основные данные элементов списка.
  TData = record
    F, N, LN : String; //Фамилия, Имя, Отчество.
  end;
  //Указатель на основные данные.
  TPData = ^TData;
 
  //Указатель на элемент списка.
  TPElem = ^TElem;
  //Элемент списка.
  TElem = record
    PData : TPData; //Указатель на основные данные.
    PNext : TPElem; //Указатель на следующий элемент списка.
  end;
 
  //Тип списка.
  TDList = record
    PFirst : TPElem;
    PLast : TPElem;
  end;
 
//Процедуры для работы со списком.
 
//Начальная инициализация списка. Внимание! Эту процедуру можно выполнять
//только в отношении пустого списка. Иначе будут утечки памяти.
procedure ListInit(var aList : TDList);
begin
  aList.PFirst := nil;
  aList.PLast := nil;
end;
 
//Удаление всего списка из памяти и инициализация.
procedure ListFree(var aList : TDList);
var
  PNext, PDel : TPElem;
begin
  if aList.PFirst = nil then Exit;
 
  PNext := aList.PFirst;
  while PNext <> nil do begin
    PDel := PNext;
    PNext := PNext^.PNext;
    if PDel^.PData <> nil then Dispose(PDel^.PData);
    Dispose(PDel);
  end;
 
  ListInit(aList);
end;
 
//Добавление элемента в конец списка.
procedure ListAdd(var aList : TDList; const aData : TData);
var
  PElem : TPElem;
begin
  New(PElem);
  New(PElem^.PData);
  PElem^.PData^ := aData;
 
  PElem^.PNext := nil;
  if aList.PFirst = nil then
    aList.PFirst := PElem
  else
    aList.PLast^.PNext := PElem;
  aList.PLast := PElem;
end;
 
//Распечатка списка.
function ListToStr(const aList : TDList) : 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 + '; ';
    if PElem^.PData <> nil then
      Result := Result + PElem^.PData^.F + ' '
        + PElem^.PData^.N + ' ' + PElem^.PData^.LN;
    PElem := PElem^.PNext;
  end;
end;
 
//Пузырьковая сортировка по возрастанию.
procedure SortBubbleAsc(const aList : TDList);
var
  //P1 и P2 - указатели на текущий и на следующий элемент.
  //PEnd и P - указатели на правую границу области сортировки.
  P1, P2, PEnd, P : TPElem;
  //Указатель на основные данные элемента списка.
  PData : TPData;
  //F - флаг для пузырьковой сортировки. Показывает - была ли хотябы одна
  //перестановка элементов на текущей итерации (на текущем проходе области сортировки).
  //FRepl - флаг, показывающий, требуется ли перестановка элементов.
  F, FRepl : Boolean;
begin
  //Если список пуст или содержит только один элемент, то выходим.
  if aList.PFirst = aList.PLast then Exit;
 
  //PEnd и P - указатели на правую границу области сортировки.
  //После каждой итерации repeat - until правая граница области
  //сортировки сдвигается на 1 элемент влево.
  PEnd := aList.PLast;
  P := PEnd;
  repeat
    F := False;
 
    P1 := aList.PFirst;
    while P1 <> PEnd do begin
      //Указатель на следующий элемент.
      P2 := P1^.PNext;
      //Определяем, требуется ли перестановка элементов.
      //Логику организуем так, чтобы сортировка проходила по порядку следования
      //полей: Фамилия - Имя - Отчество.
      FRepl := False;
      if P1^.PData^.F > P2^.PData^.F then //Сравнение фамилий.
        FRepl := True
      else if P1^.PData^.F = P2^.PData^.F then
        if P1^.PData^.N > P2^.PData^.N then  //Сравнение имён.
          FRepl := True
        else if P1^.PData^.N = P2^.PData^.N then
          if P1^.PData^.LN > P2^.PData^.LN then //Сравнение отчеств.
            FRepl := True;
      //Если требуется перестановка элементов, то выполянем её.
      //Перестановка элементов заключается в перестановке указателей на
      //основные данные элементов.
      if FRepl then begin
        PData := P1^.PData;
        P1^.PData := P2^.PData;
        P2^.PData := PData;
        F := True; //Раз была перестановка, то устанавливаем флаг F в True.
      end;
      //Если мы дошли до конца области сортировки, то определяем новую правую
      //границу области сортировки - она будет сдвинута на 1 элемент влево
      //относительно прежней правой границы.
      if P2 = PEnd then P := P1;
      //Перемещаемся к следующему элементу.
      P1 := P2;
    end;
    //Смещение правой границы области сортировки на 1 элемент влево.
    PEnd := P;
    //Если на текущей итерации была хотябы одна перестановка элементов,
    //то продолжаем сортировку.
  until not F;
end;
 
procedure TForm1.Button1Click(Sender: TObject);
var
  L : TDList;
  Data : TData;
begin
  //Начальная инициализация списка.
  ListInit(L);
 
  //Создаём несколько элементов и добавляем их в список.
  Data.F := 'Фамилия3';
  Data.N := 'Имя3';
  Data.LN := 'Отчество3';
  ListAdd(L, Data);
 
  Data.F := 'Фамилия2';
  Data.N := 'Имя2';
  Data.LN := 'Отчество2';
  ListAdd(L, Data);
 
  Data.F := 'Фамилия2';
  Data.N := 'Имя1';
  Data.LN := 'Отчество2';
  ListAdd(L, Data);
 
  Data.F := 'Фамилия2';
  Data.N := 'Имя1';
  Data.LN := 'Отчество1';
  ListAdd(L, Data);
 
  Data.F := 'Фамилия1';
  Data.N := 'Имя1';
  Data.LN := 'Отчество1';
  ListAdd(L, Data);
 
  //Показываем исходный список в Мемо.
  Memo1.Lines.Add('--------------------------------------------------');
  Memo1.Lines.Add('Исходный список:');
  Memo1.Lines.Add(ListToStr(L));
 
  //Сортируем элементы по возрастанию.
  SortBubbleAsc(L);
 
  //Показываем список после сортировки.
  Memo1.Lines.Add('Список после сортировки по возрастанию (неубыванию):');
  Memo1.Lines.Add(ListToStr(L));
 
  //Удаление списка из памяти.
  ListFree(L);
end;