Dynamische Arrays "zu Fuß"

[w3seek]

Hier eine aehnliche Implementierung von TList (allerdings als verkettete liste) von einem sehr alten projekt von mir:

Delphi-Quellcode:

type
{ ****************************************************************************
  * TList                                                                    *
  **************************************************************************** }
  PListItem = ^TListItem;
  TListItem = record
    Data: Pointer;
    Prev: PListItem;
    Next: PListItem;
  end;

  TList = class
  private
    FStart: PListItem;
    FEnd: PListItem;
    FCount: Integer;
    FCurrent: PListItem;
  public
    constructor Create;
    destructor Destroy; override;
    procedure Clear;
    procedure Add(Data: Pointer);
    function Count: Integer;
    function GetItem(Index: Integer): Pointer;
    procedure SetItem(Index: Integer; Data: Pointer);
    function Remove(Data: Pointer): Boolean;
    function Delete(Index: Integer): Boolean;
    procedure BeginWalk;
    procedure BeginWalkEnd;
    function Walk(var Data: Pointer): Boolean;
    function WalkBack(var Data: Pointer): Boolean;
    function GetCurrent(var Data: Pointer): Boolean;
    function SetCurrent(Data: Pointer): Boolean;
    function IndexOf(Data: Pointer): Integer;
  end;

{ ****************************************************************************
  * TList                                                                    *
  **************************************************************************** }

constructor TList.Create;
begin
  inherited Create;
  FStart := nil;
  FEnd := nil;
  FCount := 0;
  FCurrent := nil;
end;

destructor TList.Destroy;
begin
  try
    Clear;
  finally
    inherited Destroy;
  end;
end;

procedure TList.Clear;
var
  Current: PListItem;
  Next: PListItem;
begin
  Current := FStart;
  while Current <> nil do begin
    Next := Current^.Next;
    try
      Dispose(Current);
    finally
      Current := Next;
    end;
  end;
  FStart := nil;
  FEnd := nil;
  FCount := 0;
  FCurrent := nil;
end;

procedure TList.Add(Data: Pointer);
var
  item: PListItem;
begin
  New(item);
  item^.Data := Data;
  if (FEnd = nil) or (FStart = nil) then begin
    item^.Prev := nil;
    item^.Next := nil;
    FStart := item;
    FEnd := item;
  end else begin
    FEnd^.Next := item;
    item^.Next := nil;
    item^.Prev := FEnd;
    FEnd := item;
  end;
  Inc(FCount);
end;

function TList.Count: Integer;
begin
  Result := FCount;
end;

function TList.GetItem(Index: Integer): Pointer;
var
  x: Integer;
  item: PListItem;
begin
  item := FStart;
  for x := 1 to Index do begin
    if item = nil then begin
      Break;
    end;
    item := item^.Next;
  end;
  if item = nil then begin
    Result := nil;
  end else begin
    Result := item^.Data;
  end;
end;

procedure TList.SetItem(Index: Integer; Data: Pointer);
var
  x: Integer;
  item: PListItem;
begin
  item := FStart;
  for x := 1 to Index do begin
    if item = nil then begin
      Break;
    end;
    item := item^.Next;
  end;
  if item <> nil then begin
    item^.Data := Data;
  end;
end;

function TList.Remove(Data: Pointer): Boolean;
var
  item, next: PListItem;
begin
  Result := false;
  item := FStart;
  while item <> nil do begin
    next := item^.Next;
    if item^.Data = Data then begin
      if item^.Prev <> nil then begin
        item^.Prev^.Next := next;
        if next <> nil then begin
          next^.Prev := item^.Prev;
        end else begin
          FEnd := item^.Prev;
          item^.Prev^.Next := nil;
        end;
      end else begin
        FStart := next;
        if next <> nil then begin
          next^.Prev := nil;
        end else begin
          FEnd := item;
        end;
      end;
      try
        Dec(FCount);
        if item = FCurrent then begin
          if FCurrent <> nil then begin
            FCurrent := FCurrent^.Prev;
          end;
        end;
        Dispose(item);
      finally
        Result := true;
      end;
      Break;
    end;
    item := next;
  end;
end;

function TList.Delete(Index: Integer): Boolean;
var
  item, next: PListItem;
  x: Integer;
begin
  Result := false;
  item := FStart;
  x := 0;
  while (item <> nil) and (x <= Index) do begin
    next := item^.Next;
    if x = Index then begin
      if item^.Prev <> nil then begin
        item^.Prev^.Next := next;
        if next <> nil then begin
          next^.Prev := item^.Prev;
        end else begin
          FEnd := item^.Prev;
          item^.Prev^.Next := nil;
        end;
      end else begin
        FStart := next;
        if next <> nil then begin
          next^.Prev := nil;
        end else begin
          FEnd := item;
        end;
      end;
      try
        Dec(FCount);
        if item = FCurrent then begin
          if FCurrent <> nil then begin
            FCurrent := FCurrent^.Prev;
          end;
        end;
        Dispose(item);
      finally
        Result := true;
      end;
      Break;
    end;
    item := next;
    Inc(x);
  end;
end;

procedure TList.BeginWalk;
begin
  FCurrent := FStart;
end;

procedure TList.BeginWalkEnd;
begin
  FCurrent := FEnd;
end;

function TList.Walk(var Data: Pointer): Boolean;
begin
  Result := FCurrent <> nil;
  if Result then begin
    Data := FCurrent^.Data;
    FCurrent := FCurrent^.Next;
  end;
end;

function TList.WalkBack(var Data: Pointer): Boolean;
begin
  Result := FCurrent <> nil;
  if Result then begin
    Data := FCurrent^.Data;
    FCurrent := FCurrent^.Prev;
  end;
end;

function TList.GetCurrent(var Data: Pointer): Boolean;
begin
  Result := FCurrent <> nil;
  if Result then begin
    Result := FCurrent^.Prev <> nil;
    if Result then begin
      Data := FCurrent^.Prev^.Data;
    end else begin
      Data := FCurrent^.Data;
    end;
  end;
end;

function TList.SetCurrent(Data: Pointer): Boolean;
begin
  Result := FCurrent <> nil;
  if Result then begin
    Result := FCurrent^.Prev <> nil;
    if Result then begin
      FCurrent^.Prev^.Data := Data;
    end else begin
      FCurrent^.Data := Data;
    end;
  end;
end;

function TList.IndexOf(Data: Pointer): Integer;
var
  item: PListItem;
  x: Integer;
begin
  Result := -1;
  x := 0;
  item := FStart;
  while item <> nil do begin
    if item^.Data = Data then begin
      Result := x;
      Break;
    end;
    Inc(x);
    item := item^.Next;
  end;
end;

[edit=Luckie]Wir haben Delphi-Tags. :zwinker: Mfg, Luckie[/edit]