Alphabetisch sortieren

[Jens Schumann]

Hallo,
das habe ich 1997 irgendwo in den Borland Newsgroups gefunden

Delphi-Quellcode:

Procedure SortStringgrid( Grid: TStringGrid; byColumn: LongInt;
                          ascending: Boolean );
  Procedure ExchangeGridRows( i, j: Integer );
  Var
    k: Integer;
  Begin
    With Grid Do
      For k:= 0 To ColCount-1 Do
        Cols[k].Exchange(i,j);
  End;

  procedure QuickSort(L, R: Integer);
  var
    I, J: Integer;
    P: String;
  begin
    repeat
      I := L;
      J := R;
      P := Grid.Cells[byColumn, (L + R) shr 1];
      repeat
        while CompareStr(Grid.Cells[byColumn, I], P) < 0 do Inc(I);
        while CompareStr(Grid.Cells[byColumn, J], P) > 0 do Dec(J);
        if I <= J then
        begin
          If I <> J Then
            ExchangeGridRows( I, J );
          Inc(I);
          Dec(J);
        end;
      until I > J;
      if L < J then QuickSort(L, J);
      L := I;
    until I >= R;
  end;
 Procedure InvertGrid;
   Var
     i, j: Integer;
   Begin
     i:= Grid.Fixedrows;
     j:= Grid.Rowcount-1;
     While i < j Do Begin
       ExchangeGridRows( I, J );
       Inc( i );
       Dec( j );
     End; { While }
   End;
Begin
  Screen.Cursor := crHourglass;
  Grid.Perform( WM_SETREDRAW, 0, 0 );
  try
    QuickSort( Grid.FixedRows, Grid.Rowcount-1 );
    If not ascending Then
      InvertGrid;
  finally
    Grid.Perform( WM_SETREDRAW, 1, 0 );
    Grid.Refresh;
    Screen.Cursor := crDefault;
  end;
End;

Procedure SortStringGridByFloatCol( Grid: TStringGrid; byColumn: LongInt;
                                   ascending: Boolean );
  Procedure ExchangeGridRows( i, j: Integer );
  Var
    k: Integer;
  Begin
    With Grid Do
      For k:= 0 To ColCount-1 Do
        Cols[k].Exchange(i,j);
  End;

  function DeleteChar(const aStr : String; aChar : Char) : String;
  begin
    Result:=aStr;
    While Pos(aChar,Result)>0 do
      System.Delete(Result,Pos(aChar,Result),1);
  end;

  procedure QuickSort(L, R: Integer);
  var
    I, J: Integer;
    P: String;
  begin
    repeat
      I := L;
      J := R;
      P := Grid.Cells[byColumn, (L + R) shr 1];
      repeat
        while StrToFloat(DeleteChar(Grid.Cells[byColumn, I],'.')) < StrToFloat(DeleteChar(P,'.'))  do Inc(I);
        while StrToFloat(DeleteChar(Grid.Cells[byColumn, J],'.')) > StrToFloat(DeleteChar(P,'.'))  do Dec(J);
        if I <= J then
        begin
          If I <> J Then
            ExchangeGridRows( I, J );
          Inc(I);
          Dec(J);
        end;
      until I > J;
      if L < J then QuickSort(L, J);
      L := I;
    until I >= R;
  end;
 Procedure InvertGrid;
   Var
     i, j: Integer;
   Begin
     i:= Grid.Fixedrows;
     j:= Grid.Rowcount-1;
     While i < j Do Begin
       ExchangeGridRows( I, J );
       Inc( i );
       Dec( j );
     End; { While }
   End;
Begin
  Screen.Cursor := crHourglass;
  Grid.Perform( WM_SETREDRAW, 0, 0 );
  try
    QuickSort( Grid.FixedRows, Grid.Rowcount-1 );
    If not ascending Then
      InvertGrid;
  finally
    Grid.Perform( WM_SETREDRAW, 1, 0 );
    Grid.Refresh;
    Screen.Cursor := crDefault;
  end;
End;