ListBox адекватная сортировка

uses
  Math;
 
{Функции типа TStringListSortCompare для сравнения элементов при сортировке.
 
Этот тип определён в модуле Classes таким образом:
type TStringListSortCompare = function(List: TStringList; Index1, Index2: Integer): Integer;
Логика работы функции должна быть такой:
1. Если элемент с индексом Index1 должен следовать до элемента с индексом
   Index2, то функция должна вернуть значение меньшее нуля.
2. Если элемент с индексом Index1 должен следовать после элемента с индексом
   Index2, то функция должна вернуть значение большее нуля.
3. Если элементы с индексами Index1 и Index2 равны, то функция
   должна вернуть значение равное нулю.}
 
{ Функция сравнения для сортировки элементов по возрастанию.
  строковые элементы aSl[Index1] и aSl[Index2] раскладываются на части по
  разделителям ['.', '_'] и представляются в виде двух списков. Далее выполняется
  попарное сравнение полученных частей.
  Каждая пара частей сравнивается так:
  - Если часть не распознана, как число, то соответствующий элемент перемещается
    в конец списка.
  - Если обе части не распознаны, как числа, то они сравниваются по правилам сравнения строк. }
function CompAsc(aSl: TStringList; aIndex1, aIndex2: Integer) : Integer;
const
  { Вспомогательные списки. С помощью директивы $J+ объявляем их, как статические
    переменные. Статическая переменная это такая переменная, которая сохраняет
    своё значение при выходе управления из области её определения.
    Т. е., статические переменные, определённые в подпрограмме, сохранят свои
    значения между её вызовами. }
  {$J+} //Разрешение на изменение типизированных констант.
  Slt1 : TStringList = nil;
  Slt2 : TStringList = nil;
  {$J-} //Запрет на изменение типизированных констант.
var
  i, N1, N2 : Integer;
  S1, S2 : String;
begin
  Result := 0;
  //Условимся, что aIndex1 = -1 - это знак того, что надо освободить память,
  //выделенную для экземпляров, на которые указывают Slt1 и Slt2.
  if aIndex1 = -1 then
  begin
    FreeAndNil(Slt1);
    FreeAndNil(Slt2);
    Exit;
  end;
  //Если вспомогательные списки ещё не созданы, то создаём их.
  if not Assigned(Slt1) then
    Slt1 := TStringList.Create;
  if not Assigned(Slt2) then
    Slt2 := TStringList.Create;
  //Разбиваем строки на части по разделителям ['.', '_'].
  ExtractStrings(['.', '_'], [], PChar(aSl[aIndex1]), Slt1);
  ExtractStrings(['.', '_'], [], PChar(aSl[aIndex2]), Slt2);
 
  //Последовательное сравнение по полученным частям.
  for i := 0 to Min(Slt1.Count, Slt2.Count) - 1 do
  begin
    //Получаем числовые представления.
    S1 := Slt1[i];
    N1 := StrToIntDef(S1, High(Integer));
    S2 := Slt2[i];
    N2 := StrToIntDef(S2, High(Integer));
    //Сравнение.
    if N1 < N2 then
      Result := -1
    else if N1 > N2 then
      Result := 1
    else if N1 < High(Integer) then
      Result := 0
    //Если S1 и S2 не распознаны, как записи чисел, то выполняется сравнение строк S1 и S2.
    else if S1 < S2 then
      Result := -1
    else if S1 > S2 then
      Result := 1
    else
      Result := 0;
    //Если сравение текущих частей дало результат больше/меньше, то сравнение
    //следующих частей не имеет смысла. В этом случае выходим из цикла.
    if Result <> 0 then
      Break;
  end;
 
  //Если предыдущий цикл сравнений показал равенство элементов, то бОльшим
  //считаем тот элемент, которому соответствует более длинный список.
  if Result = 0 then
    if Slt1.Count < Slt2.Count then
      Result := -1
    else if Slt1.Count > Slt2.Count then
      Result := 1;
 
  Slt1.Clear;
  Slt2.Clear;
end;
 
{ Функция сравнения для сортировки элементов по убыванию.
  строковые элементы aSl[Index1] и aSl[Index2] раскладываются на части по
  разделителям ['.', '_'] и представляются в виде двух списков. Далее выполняется
  попарное сравнение полученных частей.
  Каждая пара частей сравнивается так:
  - Если часть не распознана, как число, то соответствующий элемент перемещается
    в конец списка.
  - Если обе части не распознаны, как числа, то они сравниваются по правилам сравнения строк. }
function CompDesc(aSl: TStringList; aIndex1, aIndex2: Integer) : Integer;
const
  { Вспомогательные списки. С помощью директивы $J+ объявляем их, как статические
    переменные. Статическая переменная это такая переменная, которая сохраняет
    своё значение при выходе управления из области её определения.
    Т. е., статические переменные, определённые в подпрограмме, сохранят свои
    значения между её вызовами. }
  {$J+} //Разрешение на изменение типизированных констант.
  Slt1 : TStringList = nil;
  Slt2 : TStringList = nil;
  {$J-} //Запрет на изменение типизированных констант.
var
  i, N1, N2 : Integer;
  S1, S2 : String;
begin
  Result := 0;
  //Условимся, что aIndex1 = -1 - это знак того, что надо освободить память,
  //выделенную для экземпляров, на которые указывают Slt1 и Slt2.
  if aIndex1 = -1 then
  begin
    FreeAndNil(Slt1);
    FreeAndNil(Slt2);
    Exit;
  end;
  //Если вспомогательные списки ещё не созданы, то создаём их.
  if not Assigned(Slt1) then
    Slt1 := TStringList.Create;
  if not Assigned(Slt2) then
    Slt2 := TStringList.Create;
  //Разбиваем строки на части по разделителям ['.', '_'].
  ExtractStrings(['.', '_'], [], PChar(aSl[aIndex1]), Slt1);
  ExtractStrings(['.', '_'], [], PChar(aSl[aIndex2]), Slt2);
 
  //Последовательное сравнение по полученным частям.
  for i := 0 to Min(Slt1.Count, Slt2.Count) - 1 do
  begin
    //Получаем числовые представления.
    S1 := Slt1[i];
    N1 := StrToIntDef(S1, High(Integer));
    S2 := Slt2[i];
    N2 := StrToIntDef(S2, High(Integer));
    //Сравнение.
    if N1 < N2 then
      Result := 1
    else if N1 > N2 then
      Result := -1
    else if N1 < High(Integer) then
      Result := 0
    //Если S1 и S2 не распознаны, как записи чисел, то выполняется сравнение строк S1 и S2.
    else if S1 < S2 then
      Result := 1
    else if S1 > S2 then
      Result := -1
    else
      Result := 0;
    //Если сравение текущих частей дало результат больше/меньше, то сравнение
    //следующих частей не имеет смысла. В этом случае выходим из цикла.
    if Result <> 0 then
      Break;
  end;
 
  //Если предыдущий цикл сравнений показал равенство элементов, то бОльшим
  //считаем тот элемент, которому соответствует более длинный список.
  if Result = 0 then
    if Slt1.Count < Slt2.Count then
      Result := 1
    else if Slt1.Count > Slt2.Count then
      Result := -1;
 
  Slt1.Clear;
  Slt2.Clear;
end;

//Пример использования.
procedure TForm1.Button1Click(Sender: TObject);
var
  Sl : TStringList;
begin
  //Сортировка списка.
  Sl := TStringList.Create;
  Sl.Assign(ListBox1.Items);
  try
    //Сортировка.
    if RadioButton1.Checked then      //По возрастанию.
      Sl.CustomSort(CompAsc)
    else if RadioButton2.Checked then //По убыванию.
      Sl.CustomSort(CompDesc);
    ListBox1.Items.Assign(Sl);
  finally
    FreeAndNil(Sl);
    //Вызов функции сравнения с флагом -1 - для освобождения памяти.
    CompAsc(nil, -1, -1);
  end;
end;

unit Unit1;
 
interface
 
uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, Grids, StdCtrls;
 
type
  TForm1 = class(TForm)
    ListBox1: TListBox;
    Button1: TButton;
    Button2: TButton;
    RadioButton1: TRadioButton;
    RadioButton2: TRadioButton;
    procedure FormCreate(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;
 
var
  Form1: TForm1;
 
implementation
 
{$R *.dfm}
 
uses
  Math;
 
{Функции типа TStringListSortCompare для сравнения элементов при сортировке.
 
Этот тип определён в модуле Classes таким образом:
type TStringListSortCompare = function(List: TStringList; Index1, Index2: Integer): Integer;
Логика работы функции должна быть такой:
1. Если элемент с индексом Index1 должен следовать до элемента с индексом
   Index2, то функция должна вернуть значение меньшее нуля.
2. Если элемент с индексом Index1 должен следовать после элемента с индексом
   Index2, то функция должна вернуть значение большее нуля.
3. Если элементы с индексами Index1 и Index2 равны, то функция
   должна вернуть значение равное нулю.}
 
{ Функция сравнения для сортировки элементов по возрастанию.
  строковые элементы aSl[Index1] и aSl[Index2] раскладываются на части по
  разделителям ['.', '_'] и представляются в виде двух списков. Далее выполняется
  попарное сравнение полученных частей.
  Каждая пара частей сравнивается так:
  - Если часть не распознана, как число, то соответствующий элемент перемещается
    в конец списка.
  - Если обе части не распознаны, как числа, то они сравниваются по правилам сравнения строк. }
function CompAsc(aSl: TStringList; aIndex1, aIndex2: Integer) : Integer;
const
  { Вспомогательные списки. С помощью директивы $J+ объявляем их, как статические
    переменные. Статическая переменная это такая переменная, которая сохраняет
    своё значение при выходе управления из области её определения.
    Т. е., статические переменные, определённые в подпрограмме, сохранят свои
    значения между её вызовами. }
  {$J+} //Разрешение на изменение типизированных констант.
  Slt1 : TStringList = nil;
  Slt2 : TStringList = nil;
  {$J-} //Запрет на изменение типизированных констант.
var
  i, N1, N2 : Integer;
  S1, S2 : String;
begin
  Result := 0;
  //Условимся, что aIndex1 = -1 - это знак того, что надо освободить память,
  //выделенную для экземпляров, на которые указывают Slt1 и Slt2.
  if aIndex1 = -1 then
  begin
    FreeAndNil(Slt1);
    FreeAndNil(Slt2);
    Exit;
  end;
  //Если вспомогательные списки ещё не созданы, то создаём их.
  if not Assigned(Slt1) then
    Slt1 := TStringList.Create;
  if not Assigned(Slt2) then
    Slt2 := TStringList.Create;
  //Разбиваем строки на части по разделителям ['.', '_'].
  ExtractStrings(['.', '_'], [], PChar(aSl[aIndex1]), Slt1);
  ExtractStrings(['.', '_'], [], PChar(aSl[aIndex2]), Slt2);
 
  //Последовательное сравнение по полученным частям.
  for i := 0 to Min(Slt1.Count, Slt2.Count) - 1 do
  begin
    //Получаем числовые представления.
    S1 := Slt1[i];
    N1 := StrToIntDef(S1, High(Integer));
    S2 := Slt2[i];
    N2 := StrToIntDef(S2, High(Integer));
    //Сравнение.
    if N1 < N2 then
      Result := -1
    else if N1 > N2 then
      Result := 1
    else if N1 < High(Integer) then
      Result := 0
    //Если S1 и S2 не распознаны, как записи чисел, то выполняется сравнение строк S1 и S2.
    else if S1 < S2 then
      Result := -1
    else if S1 > S2 then
      Result := 1
    else
      Result := 0;
    //Если сравение текущих частей дало результат больше/меньше, то сравнение
    //следующих частей не имеет смысла. В этом случае выходим из цикла.
    if Result <> 0 then
      Break;
  end;
 
  //Если предыдущий цикл сравнений показал равенство элементов, то бОльшим
  //считаем тот элемент, которому соответствует более длинный список.
  if Result = 0 then
    if Slt1.Count < Slt2.Count then
      Result := -1
    else if Slt1.Count > Slt2.Count then
      Result := 1;
 
  Slt1.Clear;
  Slt2.Clear;
end;
 
{ Функция сравнения для сортировки элементов по убыванию.
  строковые элементы aSl[Index1] и aSl[Index2] раскладываются на части по
  разделителям ['.', '_'] и представляются в виде двух списков. Далее выполняется
  попарное сравнение полученных частей.
  Каждая пара частей сравнивается так:
  - Если часть не распознана, как число, то соответствующий элемент перемещается
    в конец списка.
  - Если обе части не распознаны, как числа, то они сравниваются по правилам сравнения строк. }
function CompDesc(aSl: TStringList; aIndex1, aIndex2: Integer) : Integer;
const
  { Вспомогательные списки. С помощью директивы $J+ объявляем их, как статические
    переменные. Статическая переменная это такая переменная, которая сохраняет
    своё значение при выходе управления из области её определения.
    Т. е., статические переменные, определённые в подпрограмме, сохранят свои
    значения между её вызовами. }
  {$J+} //Разрешение на изменение типизированных констант.
  Slt1 : TStringList = nil;
  Slt2 : TStringList = nil;
  {$J-} //Запрет на изменение типизированных констант.
var
  i, N1, N2 : Integer;
  S1, S2 : String;
begin
  Result := 0;
  //Условимся, что aIndex1 = -1 - это знак того, что надо освободить память,
  //выделенную для экземпляров, на которые указывают Slt1 и Slt2.
  if aIndex1 = -1 then
  begin
    FreeAndNil(Slt1);
    FreeAndNil(Slt2);
    Exit;
  end;
  //Если вспомогательные списки ещё не созданы, то создаём их.
  if not Assigned(Slt1) then
    Slt1 := TStringList.Create;
  if not Assigned(Slt2) then
    Slt2 := TStringList.Create;
  //Разбиваем строки на части по разделителям ['.', '_'].
  ExtractStrings(['.', '_'], [], PChar(aSl[aIndex1]), Slt1);
  ExtractStrings(['.', '_'], [], PChar(aSl[aIndex2]), Slt2);
 
  //Последовательное сравнение по полученным частям.
  for i := 0 to Min(Slt1.Count, Slt2.Count) - 1 do
  begin
    //Получаем числовые представления.
    S1 := Slt1[i];
    N1 := StrToIntDef(S1, High(Integer));
    S2 := Slt2[i];
    N2 := StrToIntDef(S2, High(Integer));
    //Сравнение.
    if N1 < N2 then
      Result := 1
    else if N1 > N2 then
      Result := -1
    else if N1 < High(Integer) then
      Result := 0
    //Если S1 и S2 не распознаны, как записи чисел, то выполняется сравнение строк S1 и S2.
    else if S1 < S2 then
      Result := 1
    else if S1 > S2 then
      Result := -1
    else
      Result := 0;
    //Если сравение текущих частей дало результат больше/меньше, то сравнение
    //следующих частей не имеет смысла. В этом случае выходим из цикла.
    if Result <> 0 then
      Break;
  end;
 
  //Если предыдущий цикл сравнений показал равенство элементов, то бОльшим
  //считаем тот элемент, которому соответствует более длинный список.
  if Result = 0 then
    if Slt1.Count < Slt2.Count then
      Result := 1
    else if Slt1.Count > Slt2.Count then
      Result := -1;
 
  Slt1.Clear;
  Slt2.Clear;
end;
 
{Заполнение списка случайными значениями в нужном формате.}
procedure ListInit(aSl : TStrings);
begin
  aSl.Clear;
  (*
  aSl.Add('edmn_DU.001_0_3_imp');
  aSl.Add('edmn_DU.001_0_20_imp');
  aSl.Add('edmn_DU.001_0_11_imp');
  aSl.Add('edmn_DU.001_0_13_imp');
  aSl.Add('edmn_DU.001_0_22_imp');
  aSl.Add('edmn_DU.001_0_17_imp');
  aSl.Add('edmn_DU.001_0_19_imp');
  aSl.Add('edmn_DU.001_0_15_imp');
  aSl.Add('edmn_DU.001_0_7_imp');
  aSl.Add('edmn_DU.001_0_31_imp');
  aSl.Add('edmn_DU.001_0_9_imp');
  aSl.Add('edmn_DU.001_0_5_imp');
  //*)
 
  //(*
  aSl.Add('edmn_DU.001_B_3_imp');
  aSl.Add('edmn_DU.001_0_20_imp');
  aSl.Add('edmn_DU.001_1_11_imp');
  aSl.Add('edmn_DU.001_B_13_imp');
  aSl.Add('edmn_DU.001_0_22_imp');
  aSl.Add('edmn_DU.001_A_17_imp');
  aSl.Add('edmn_DU.001_0_19_imp');
  aSl.Add('edmn_DU.001_0_15_imp');
  aSl.Add('edmn_DU.001_1_7_imp');
  aSl.Add('edmn_DU.001_0_31_imp');
  aSl.Add('edmn_DU.001_A_9_imp');
  aSl.Add('edmn_DU.001_0_5_imp');
  //*)
end;
 
//После создания формы.
procedure TForm1.FormCreate(Sender: TObject);
begin
  ListInit(ListBox1.Items); //Инициализация списка.
end;
 
//Пример использования.
procedure TForm1.Button1Click(Sender: TObject);
var
  Sl : TStringList;
begin
  //Сортировка списка.
  Sl := TStringList.Create;
  Sl.Assign(ListBox1.Items);
  try
    //Сортировка.
    if RadioButton1.Checked then      //По возрастанию.
      Sl.CustomSort(CompAsc)
    else if RadioButton2.Checked then //По убыванию.
      Sl.CustomSort(CompDesc);
    ListBox1.Items.Assign(Sl);
  finally
    FreeAndNil(Sl);
    //Вызов функции сравнения с флагом -1 - для освобождения памяти.
    CompAsc(nil, -1, -1);
  end;
end;
 
//Инициализация и заполнение таблицы.
procedure TForm1.Button2Click(Sender: TObject);
begin
  ListInit(ListBox1.Items);
end;
 
end.