Feld sortieren und damit weiterarbeiten

[Bjoerk]

Und natürlich wenn sich Count ändert. Am besten, man spielt es an einem konkreten Beispiel durch.

Ungetestet:

Delphi-Quellcode:

unit uSortedDaten;

interface

uses
  Windows, SysUtils, Dialogs, Classes, Math;

type
  TDatenItem = record
    Id: integer;
    Name: string;
  end;

  TDatenSortFlag = (dsfId, dsfName);

  TDaten = class
  private
    FItems: array of TDatenItem;
    FSorted: boolean;
    FSortFlag: TDatenSortFlag;
    FOnChange, FOnChanging: TNotifyEvent;
    function Get(Index: integer): TDatenItem;
    function GetCount: integer;
    procedure Put(Index: integer; const Value: TDatenItem);
    procedure SetCount(Value: integer);
    procedure SetSorted(const Value: boolean);
    procedure SortExchange(Index1, Index2: integer);
    function SortCompare(const A, B: TDatenItem): integer;
    procedure QuickSort(L, R: integer);
    procedure Changed;
    procedure Changing;
  public
    procedure Clear;
    procedure Add(const Value: TDatenItem);
    procedure Delete(Index: integer);
    procedure Insert(Index: integer; const Value: TDatenItem);
    procedure Exchange(Index1, Index2: integer);
    procedure Sort;
    function IndexOfID(Value: integer): integer;
    procedure Assign(Value: TDaten);
    procedure LoadFromFile(const FileName: string);
    procedure SaveToFile(const FileName: string);
    destructor Destroy; override;
    property Count: integer read GetCount;
    property Sorted: boolean read FSorted write SetSorted;
    property SortFlag: TDatenSortFlag read FSortFlag write FSortFlag;
    property OnChange: TNotifyEvent read FOnChange write FOnChange;
    property OnChanging: TNotifyEvent read FOnChanging write FOnChanging;
    property Items[Index: integer]: TDatenItem read Get write Put; default;
  end;

implementation

type
  TFileStreamEx = class(TFileStream)
  private
    function ReadAnsiString: AnsiString;
  public
    function ReadInteger: integer;
    function ReadString: string;
    procedure WriteInteger(const Value: integer);
    procedure WriteString(const Value: string);
  end;

{ procedural }

function Compare(const A, B: TDatenItem): boolean;
begin
  Result := (A.Id = B.Id) and (A.Name = B.Name);
end;

{ TDaten }

destructor TDaten.Destroy;
begin
  FOnChange := nil;
  FOnChanging := nil;
  Setlength(FItems, 0);
end;

procedure TDaten.Changed;
begin
  if FSorted then
    Sort;
  if Assigned(FOnChange) then
    FOnChange(Self);
end;

procedure TDaten.Changing;
begin
  if Assigned(FOnChanging) then
    FOnChanging(Self);
end;

procedure TDaten.Clear;
begin
  if Count <> 0 then
  begin
    Changing;
    SetLength(FItems, 0);
    Changed;
  end;
end;

procedure TDaten.Add(const Value: TDatenItem);
begin
  Insert(Count, Value);
end;

procedure TDaten.Delete(Index: integer);
var
  I: integer;
begin
  Changing;
  for I := Index to Count - 2 do
    FItems[I] := FItems[I + 1];
  SetCount(Count - 1);
  Changed;
end;

procedure TDaten.Exchange(Index1, Index2: integer);
var
  Temp: TDatenItem;
begin
  Changing;
  Temp := FItems[Index1];
  FItems[Index1] := FItems[Index2];
  FItems[Index2] := Temp;
  Changed;
end;

function TDaten.Get(Index: integer): TDatenItem;
begin
  Result := FItems[Index];
end;

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

procedure TDaten.Insert(Index: integer; const Value: TDatenItem);
var
  I: integer;
begin
  Changing;
  SetCount(Count + 1);
  for I := Count - 1 downto Index + 1 do
    FItems[I] := FItems[I - 1];
  FItems[Index] := Value;
  Changed;
end;

procedure TDaten.Put(Index: integer; const Value: TDatenItem);
begin
  if not Compare(Value, FItems[Index]) then
  begin
    Changing;
    FItems[Index] := Value;
    Changed;
  end;
end;

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

procedure TDaten.SortExchange(Index1, Index2: integer);
var
  Temp: TDatenItem;
begin
  Temp := FItems[Index1];
  FItems[Index1] := FItems[Index2];
  FItems[Index2] := Temp;
end;

function TDaten.SortCompare(const A, B: TDatenItem): integer;
begin
  if FSortFlag = dsfName then
    Result := AnsiCompareText(A.Name, B.Name)
  else
    Result := CompareValue(A.Id, B.Id);
end;

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

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

procedure TDaten.SetSorted(const Value: boolean);
begin
  if FSorted <> Value then
  begin
    Changing;
    FSorted := Value;
    Changed;
  end;
end;

function TDaten.IndexOfID(Value: integer): integer;
var
  I: integer;
begin
  Result := -1;
  for I := 0 to Count - 1 do
    if FItems[I].Id = Value then
    begin
      Result := I;
      Break;
    end;
end;

procedure TDaten.Assign(Value: TDaten);
var
  I: integer;
begin
  Clear;
  for I := 0 to Value.Count - 1 do
    Add(Value[I]);
end;

procedure TDaten.LoadFromFile(const FileName: string);
var
  Stream: TFileStreamEx;
  I, N: integer;
  Value: TDatenItem;
begin
  if FileExists(FileName) then
  begin
    Clear;
    Stream := TFileStreamEx.Create(FileName, fmOpenRead or fmShareDenyNone);
    try
      N := Stream.ReadInteger;
      for I := 0 to N - 1 do
      begin
        Value.Id := Stream.ReadInteger;
        Value.Name := Stream.ReadString;
        Add(Value);
      end;
    finally
      Stream.Free;
    end;
  end;
end;

procedure TDaten.SaveToFile(const FileName: string);
var
  Stream: TFileStreamEx;
  I: integer;
begin
  Stream := TFileStreamEx.Create(FileName, fmCreate);
  try
    Stream.WriteInteger(Count);
    for I := 0 to Count - 1 do
    begin
      Stream.WriteInteger(FItems[I].Id);
      Stream.WriteString(FItems[I].Name);
    end;
  finally
    Stream.Free;
  end;
end;

{ TFileStreamEx }

function TFileStreamEx.ReadInteger: integer;
begin
  ReadBuffer(Result, SizeOf(integer));
end;

function TFileStreamEx.ReadAnsiString: AnsiString;
var
  N: integer;
begin
  N := ReadInteger;
  SetLength(Result, N);
  if N > 0 then
    ReadBuffer(Result[1], N);
end;

function TFileStreamEx.ReadString: string; // need AnsiStringBuffer
begin
  Result := ReadAnsiString;
end;

procedure TFileStreamEx.WriteInteger(const Value: integer);
begin
  WriteBuffer(Value, SizeOf(integer));
end;

procedure TFileStreamEx.WriteString(const Value: string);
var
  N: integer;
begin
  N := Length(Value) * SizeOf(Char);
  WriteInteger(N);
  if N > 0 then
    WriteBuffer(Value[1], N);
end;

end.