Logo Questions Linux Laravel Mysql Ubuntu Git Menu
 

Non alphabetic sort in Delphi

Tags:

sorting

delphi

I'm trying to sort a TStringList in an especific order.

Instead of A,B,C.. I'm trying to order it in B,C,A.

I've declarated a const array with the order that I need.

I've tried with CustomSorte, but I can't understand how to write the function.

I'm trying with for loops now, but it is going really hard and confusing!

I'm not a Delphi Expert...

Thank you guys in advance!

like image 514
Dirtycoder Avatar asked Aug 19 '11 14:08

Dirtycoder


1 Answers

From the help about the TStringListSortCompare function type:

Index1 and Index2 are indexes of the items in List to compare. The callback returns:

  • a value less than 0 if the string identified by Index1 comes before the string identified by Index2
  • 0 if the two strings are equivalent
  • a value greater than 0 if the string with Index1 comes after the string identified by Index2.

So if you subtract your custom order of the second item from the custom order of the first one, then the items will be sorted like you want.

const
  Order: array[0..6] of String = ('B', 'C', 'A', 'D', 'G', 'F', 'E');

function GetStringOrder(const S: String; CaseSensitive: Boolean): Integer;
begin
  for Result := 0 to Length(Order) - 1 do
    if (CaseSensitive and (CompareStr(Order[Result], S) = 0)) or
        (not CaseSensitive and (CompareText(Order[Result], S) = 0)) then
      Exit;
  Result := Length(Order);
end;

function MyCompareStrings(List: TStringList; Index1, Index2: Integer): Integer;
begin
  Result := GetStringOrder(List[Index1], List.CaseSensitive) -
    GetStringOrder(List[Index2], List.CaseSensitive);
end;

procedure TForm1.Button1Click(Sender: TObject);
var
  List: TStringList;
begin
  List := TStringList.Create;
  try
    List.CommaText := 'A,G,a,C,B,b,F,a,B,C,c,D,d,E,D,F,G,C,A,G,d,e,f,g';
    List.CaseSensitive := True;
    List.CustomSort(MyCompareStrings);
    ListBox1.Items.Assign(List);
  finally
    List.Free;
  end;
end;
like image 175
NGLN Avatar answered Oct 31 '22 01:10

NGLN