1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:

Unit Unit1;
...

TMyForm = class(TForm)
...
MyList: TList;
PROCEDURE sortiere_es;
....
END;

Implementation

VAR
  sortierkriterium: integer;

FUNCTION callback(...):integer;
  BEGIN
  IF sortierkriterium= ...
    ...
  END;

PROCEDURE TMyForm.sortiere_es;
  BEGIN
  ....
  sortierkriterium:=...;
  MyList.sort(@callback);
  ...
  END;
END;					

1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:

PROCEDURE TMyForm.sortiere_es;
  BEGIN
  ....
  sortierkriterium:=...;

  if (Sortierkriterium = skAufsteigend) then
    MyList.Sort(@callback_Aufsteigend)
  else 
    MyList.sort(@callback_Absteigend);
  ...
  END;
END;					

1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:

IComperator = interface(IInterface)
  {GUID}
  function Compare(Item1, Item2: Pointer): Integer
end;

TMyList = class(TList)
private
  procedure QuickSort(L, R: Integer; const AComperator: IComperator);
public
  procedure Sort(const AComperator: IComperator); reintroduce;
end;

TMyComperator = class(TInterfacedObject, IComperator)
  constructor Create(AParam1: Boolean; AParam2: Integer);
private
  FParam1: Boolean;
  FParam2: Integer;
public
  function Compare(Item1, Item2: Pointer): Integer;
end;

MyList.Sort(TMyComperator.Create(True, 5));					

1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:
30:
31:
32:
33:
34:
35:

implementation 

:
:

procedure QuickSort(SortList: PPointerList; L, R: Integer;
  SCompare: TListSortCompare);

var
  I, J: Integer;
  P, T: Pointer;
begin
  repeat
    I := L;
    J := R;
    P := SortList^[(L + R) shr 1];
    repeat
      while SCompare(SortList^[I], P) < 0 do
        Inc(I);
      while SCompare(SortList^[J], P) > 0 do
        Dec(J);
      if I <= J then
      begin
        T := SortList^[I];
        SortList^[I] := SortList^[J];
        SortList^[J] := T;
        Inc(I);
        Dec(J);
      end;
    until I > J;
    if L < J then
      QuickSort(SortList, L, J, SCompare);
    L := I;
  until I >= R;
end;					

1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:
30:
31:
32:
33:
34:
35:
36:
37:
38:
39:
40:
41:
42:
43:
44:
45:
46:
47:
48:
49:
50:
51:
52:
53:
54:
55:
56:
57:
58:

implementation

TMyList = Class(TList)
          public
            function SCompare(Item1, Item2 : Pointer) : integer;
            procedure Quicksort(L, R : Integer);
          end;

implementation


procedure TMyList.QuickSort(L, R: Integer);

var
  I, J: Integer;
  P, T: Pointer;
begin
  repeat
    I := L;
    J := R;
    P := Items[(L + R) shr 1];
    repeat
      while SCompare(Items[I], P) < 0 do
        Inc(I);
      while SCompare(Items[J], P) > 0 do
        Dec(J);
      if I <= J then
      begin
        T := Items[I];
        Items[I] := Items[J];
        Items[J] := T;
        Inc(I);
        Dec(J);
      end;
    until I > J;
    if L < J then
      QuickSort(L, J);
    L := I;
  until I >= R;
end;

{(Sortierroutine-Beispiel für Strings)}

function TMyList.SCompare(Item1, Item2 : Pointer) : integer;
var
   s1, s2 : ^string;
begin
  s1 := Item1;
  s2 := Item2;
  if (s1^>s2^) then
    Result := 1
  else if (s1^<s2^) then
    Result := -1
  else
    Result := 0;
end;
:
:					

1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:
30:
31:
32:
33:
34:
35:
36:
37:
38:
39:
40:
41:
42:
43:
44:
45:
46:
47:
48:
49:
50:
51:
52:
53:
54:
55:
56:
57:
58:
59:
60:
61:
62:
63:
64:
65:
66:
67:

const
  isInteger = 1;
  isReal = 2;
  isString = 3;
  :
  isUnknown = 255;

type 
  TMyList = class(TList);
           fTypus : integer;

          function SCompare(p1, p2 : pointer) : integer;

          :
          property Typus : integer Read GetTypus write SetTypus;


          end;

  function TMyList.SCompare(p1, p2 : pointer) : integer;

  var
    s1, s2 : ^string;
    i1, i2 : ^longint;
    r1, r2 : ^extended;


  begin
    if Typus = isInteger then
    begin
      s1 := p1;
      s2 := p2;    
      if (s1^>s2^) then
        Result := 1
      else if (s1^<s2^) then
        Result := -1
      else
        Result := 0;
    end
    else if Typus = isReal then
    begin
      r1 := p1;
      r2 := p2;    
      if (r1^>r2^) then
        Result := 1
      else if (r1^<r2^) then
        Result := -1
      else
        Result := 0;
    end
    else if Typus = isInteger then
    begin
      i1 := p1;
      i2 := p2;    
      if (i1^>i2^) then
        Result := 1
      else if (i1^<i2^) then
        Result := -1
      else
        Result := 0;
    end
    :
// weitere Typen (z.B. Zit, Datum, ...)
    else
// falls Typus nicht bekannt, Null ausgeben
      Result := 0;
  end;					

1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:

type
  TListCompareMethod = function(Item1, Item2: Pointer): integer of object;

  TMyList = class(TList)
  private
    FCompareMethod: TListCompareMethod;
    ...
  public
    property OnCompare: TListCompareMethod read FCompareMethod write FCompareMethod;
    ...
  end;					

1:
2:
3:
4:
5:
6:
7:

procedure TForm1.dbgListeTitleClick(Column: TColumn);

begin
  Tabelle.Active := FALSE;
  Tabelle.SQL.Text := "Select * FROM '#10#13'TabellenDaten'#10#13'ORDER BY '+Column.FieldName;
  Tabelle.Active := TRUE;
end;