Сортировка строк с украинскими символами

Материал из DRKB


{ **** UBPFD *********** by kladovka.net.ru ****
>> Сортировка строк с украинскими символами

Принцип работы функции такой же как и у стандартной функции CompareText из SysUtils. Поскольку для украинских символов строки сортируются этой функцией "как попало", то я решил написать свой CompareUkrText.

Зависимости: System
Автор:       Алексей Глеб, noodlesf@mail.ru, Чернигов
Copyright:   Собственное написание (Алексей Глеб)
Дата:        1 февраля 2003 г.
********************************************** }

unit UkrSort;

interface

function CompareUkrText(S1, S2: string): Integer;
var
  // массив, который заменит ASCI таблицу
  Chars: array[1..136] of Char =
  ('1','2','3','4','5','6','7','8','9','0','A','B','C','D','E','F','G',
   'H','I','J','K','L','M','N','O','P','Q','R','S','T','U','V','W','X',
   'Y','Z','a','b','c','d','e','f','g','h','i','j','k','l','m','n','o',
   'p','q','r','s','t','u','v','w','x','y','z','А','Б','В','Г','Ґ','Д',
   'Е','Ё','Є','Ж','З','И','І','Ї','Й','К','Л','М','Н','О','П','Р','С',
   'Т','У','Ф','Х','Ц','Ч','Ш','Щ','Ъ','Ы','Ь','Э','Ю','Я','а','б','в',
   'г','ґ','д','е','ё','є','ж','з','и','і','ї','й','к','л','м','н','о',
   'п','р','с','т','у','ф','х','ц','ч','ш','щ','ъ','ы','ь','э','ю','я');

implementation

// сама функция
function CompareUkrText(S1, S2: string): Integer;

  // динам. функция получения номера символа из нашего массива
  function GetNum(C: Char): Integer;
  var
    i: Integer;
  begin
    Result := 0;
    for i := 1 to 136 do
      if Chars[i] = C then
      begin
        Result := i;
        Exit;
      end;
  end;

  // динам. функция определения "что больше???"
  function CompCh(C1, C2: Integer): Integer;
  begin
    if C1 = C2 then Result := 0;
    if C1 > C2 then Result := 1;
    if C1 < C2 then Result := -1;
  end;

var
  i, xS1, xS2, CurrR: Integer;
begin // начало функции сортировки
  Result := 0;
  CurrR := 0; // временный результат
  if S1 <> S2 then
  begin
    // сканирование строк посимвольно
    for i := 1 to Length(S1) do
    begin
      if Length(S2) >= i then
      begin
        xS1 := GetNum(S1[i]);
        xS2 := GetNum(S2[i]);
        if (xS1 <> 0) and (xS2 <> 0) and (xS1 <> xS2) then
          CurrR := CompCh(xS1, xS2)
        else
        begin
          if (xS1 = 0) or (xS2 = 0) then
          begin
            if xS2 = 0 then CurrR := 1;
            if xS1 = 0 then CurrR := -1;
          end;
        end;
        if CurrR <> 0 then
        begin
          Result := CurrR;
          Exit;
        end;
      end
      else
      begin
        Result := CurrR;
        Exit;
      end;
    end;
  end;
end;

end.


Пример использования:

function CustomSortProc(Item1, Item2: TListItem; ParamSort: Integer): Integer; stdcall;
begin
  Result := CompareUkrText(Item1.Caption, Item2.Caption);
end;

procedure TForm1.FormClick(Sender: TObject);
begin
  ListView1.CustomSort(@CustomSortProc, 0);
end;


Author: Алексей Глеб
ID: 04170