// Wenn man Stringlisten (Memo.Lines, Listbox.Items, TStringlist) sortieren
// läßt, werden diese normalerweise lexisch sortiert. Wenn sich aber nur
// (Integer)Zahlen in der Liste befinden, kommt es zu seltsamen
// Ergebnissen, da bei der Sortierung die Strings von links nach rechts
// getestet werden. Somit ist 80 größer als 1000, da 8 größer als 1 ist.
// Deshalb der folgende Code:


// Getestet mit D4 unter XP

// Variante 1: Einfaches Quicksort
//             Für positive und negative Integer-Werte,
//             aber nur für nicht allzugroße Datenmengen.

procedure NumSort(ts: TStrings); 
  procedure doit(S: TStrings; xL, xH: Integer); 
  var 
    L, H, M: Integer; 
    Tmp: string; 
  begin 
    L := xL; 
    H := xH; 
    M := strtoint(S[(L + H) div 2]); 
    repeat 
      while strtoint(S[L]) < M do Inc(L); 
      while strtoint(S[H]) > M do Dec(H); 
      if L <= H then 
      begin 
        Tmp := S[L]; 
        S[L] := S[H]; 
        S[H] := Tmp; 
        Inc(L); 
        Dec(H); 
      end; 
    until L > H; 
    if H > xL then doit(S, xL, H); 
    if L < xH then doit(S, L, xH); 
  end; 
begin 
  if ts.count > 1 then 
    doit(ts, 0, ts.count - 1) 
end; 

// Beispielaufruf: 
// Ein Memo und eine Listbox werden numerisch sortiert 
 
procedure TForm1.FormCreate(Sender: TObject); 
var x: integer; 
begin 
// --- Beispieldaten erzeugen --- 
  memo1.lines.clear; 
  listbox1.items.clear; 
  for x := 0 to 99 do begin 
    memo1.lines.add(inttostr(random(2000))); 
    listbox1.items.add(inttostr(random(4000))); 
  end; 
  memo1.scrollbars := ssBoth; 
// ------------------------------- 
end; 
 
procedure TForm1.Button9Click(Sender: TObject); 
begin 
  memo1.lines.beginupdate; 
  NumSort(memo1.lines); 
  memo1.lines.endupdate;

  NumSort(Listbox1.items); 
end; 

//--------------------------------------------------------------

// Variante 2: ReplaceSort
//             Für größere Datenmengen, aber nur positive Zahlen
//             ohne Vorzeichen. Die Zahlen dürfen im Bereich von 0 bis
//             2147483647 liegen. Diese Variante ist etwa 100 mal schneller
//             als Variante 1

procedure positivSort(st: TStrings); 
var 
  sl: TStringlist;      
  x: integer; 
begin 
  sl := TStringlist.create; 
  sl.text := st.text; 
  for x := 0 to sl.count - 1 do 
    sl[x] := stringofchar('°', 10 - length(sl[x])) + sl[x]; 
  sl.sort; 
  for x := 0 to sl.count - 1 do begin 
    sl[x] := stringreplace(sl[x], '°', '', [rfreplaceall]); 
  end; 
  st.text := sl.text; 
  sl.free; 
end;