Spaltengenau sortieren

[Bjoerk]

Gut, das geht natürlich. Auf die Idee bin ich nicht gekommen. Bin mit Uwes Algo aber eigentlich zufrieden und die Keys sind nicht sooo lang.

BTW, wie kriegt man den TSortRec in eine TList ohne New und Dispose zu verwenden?

Delphi-Quellcode:

  TSortRec = record
    C: Char;
    Pos: Integer;
  end;

  TSortRecList = class
  private
    FItems: array of TSortRec;
    function Compare(Const A, B: TSortRec): integer;
    function GetCount: integer;
    procedure SetCount(const Value: integer);
    function GetItems(Index: integer): TSortRec;
    procedure QuickSort(L, R: integer);
    procedure Exchange(const I, J: integer);
  public
    procedure Add(const S: string);
    procedure Sort;
    procedure Clear;
    property Count: integer read GetCount;
    property Items[Index: integer]: TSortRec read GetItems; default;
    destructor Destroy; override;
  end;

..

{ TSortRecList }

destructor TSortRecList.Destroy;
begin
  Clear;
  inherited;
end;

procedure TSortRecList.Clear;
begin
  SetCount(0);
end;

function TSortRecList.GetItems(Index: integer): TSortRec;
begin
  Result := FItems[Index];
end;

function TSortRecList.GetCount: integer;
begin
  Result := Length(FItems);
end;

procedure TSortRecList.SetCount(const Value: integer);
begin
  SetLength(FItems, Value);
end;

procedure TSortRecList.Add(const S: string);
var
  I, OldCount: integer;
begin
  OldCount := Count;
  SetCount(Count + Length(S));
  for I := 1 to Length(S) do
  begin
    FItems[OldCount + I - 1].C := S[I];
    FItems[OldCount + I - 1].Pos := OldCount + I;
  end;
end;

procedure TSortRecList.Exchange(const I, J: integer);
var
  Temp: TSortRec;
begin
  Temp := FItems[I];
  FItems[I] := FItems[J];
  FItems[J] := Temp;
end;

function TSortRecList.Compare(const A, B: TSortRec): integer;
begin
  if A.C > B.C then
    Result := 1
  else
    if A.C < B.C then
      Result := -1
    else
      if A.Pos > B.Pos then
        Result := 1
      else
        if A.Pos < B.Pos then
          Result := -1
        else
          Result := 0;
end;

procedure TSortRecList.QuickSort(L, R: integer);
var
  I, J, K: integer;
  Pivot: TSortRec;
begin
  repeat
    I := L;
    J := R;
    K := (L + R) shr 1;
    Pivot := FItems[K];
    repeat
      while Compare(FItems[I], Pivot) < 0 do
        Inc(I);
      while Compare(FItems[J], Pivot) > 0 do
        Dec(J);
      if I <= J then
      begin
        Exchange(I, J);
        Inc(I);
        Dec(J);
      end;
    until I > J;
    if L < J then
      QuickSort(L, J);
    L := I;
  until I >= R;
end;

procedure TSortRecList.Sort;
begin
  if Count > 1 then
    QuickSort(0, Count - 1);
end;

..

procedure TSomeForm.Button1Click(Sender: TObject);
var
  O: TSortRecList;
  I: integer;
begin
  O := TSortRecList.Create;
  try
    O.Add('NOTEBOOK');
    O.Sort;
    for I := 0 to O.Count - 1 do
      ShowMessage(Format('%s: %d', [O[I].C, O[I].Pos]));
  finally
    O.Free;
  end;
end;