Einzelnen Beitrag anzeigen

peterbelow

Registriert seit: 12. Jan 2019
Ort: Hessen
672 Beiträge
 
Delphi 11 Alexandria
 
#3

AW: Alphanumerische Stringsortierung

  Alt 16. Jul 2019, 08:47
Delphi-Quellcode:
program RioTestframe_console;

{$APPTYPE CONSOLE}

{$R *.res}

uses
  System.SysUtils, system.classes, system.character, system.math;
const
  testdata: array [0..11] of string =
  (
'cDefG',
'Abcde',
'Abc12',
'34abc',
'12345',
'BCDeF',
'BCDeFmm',
'efghi',
'efghi',
'01345',
'DEFGH',
'23456'
);

function SortCompare(List: TStringlist; i1, i2: integer): integer;
var
  S1, S2: string;
  I: Integer;
begin
  S1 := list[i1].ToUpper;
  S2 := list[i2].ToUpper;
  if Length(S2) = 0 then
    result := 1
  else if Length(S1) = 0 then
    result := -1
  else begin
    for I := 1 to Min(Length(S1), Length(S2)) do begin
      if S1[I].IsDigit = S2[I].IsDigit then
        result := ord(S1[I]) - ord(S2[I])
      else if S1[I].IsDigit then
        result := 1 // digits sort above letters
      else
        result := -1;
      if result <> 0 then
        exit;
    end; // for
  end; // else
  if result = 0 then
    // if both are equal for the length of the smaller string the longer wins
    result := length(S1) - length(S2);
end;

procedure RunTest;
var
  L: TStringlist;
  I: Integer;
begin
  L:= TStringlist.Create;
  try
    for I := Low(testdata) to High(testdata) do
      L.Add(testdata[I]);
    L.CustomSort(SortCompare);
    writeln(L.Text);
  finally
    L.Free;
  end;
end;


begin
  try
   RunTest;
  except
    on E: Exception do
      Writeln(E.ClassName, ': ', E.Message);
  end;
  WriteLn(SLinebreak, 'Hit return to exit');
  ReadLn;
end.
Peter Below
  Mit Zitat antworten Zitat