Сортировка строк с украинскими символами
Материал из 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