Referzen in ein Stream speichern

[negaH]

Ok, mal ein kleines Beispiel, mehr geht aber wirklich nicht:

Delphi-Quellcode:

type
  TBase = class(TPersistent)
  protected
    procedure ReadData(Stream: TStream); dynamic; abstract;
    procedure WriteData(Stream: TStream); dynamic; abstract;
    procedure Changed; virtual;
  public
    class function LoadFromStream(Stream: TStream): TBase; 
    procedure SaveToStream(Stream: TStream);
  end;

  TBaseClass = class of TBase;

  TPoint = class(TBase)
  private
    FX: Integer;
    FY: Integer;
    procedure SetX(Value: Integer);
    procedure SetY(Value: Integer);
  protected
    procedure ReadData(Stream: TStream); override;
    procedure WriteData(Stream: TStream); override;
  public
    constructor Create(APoint: TPoint); reintoduce; overload;
    constructor Create(AX, AY: Integer); reintruduce; overload;
    procedure Assign(Source: TPersistent); override;
  published
    property X: Integer read FX write SetX;
    property Y: Integer read FY write SetY; 
  end;
  
  TKante = class(TBase)
  private
    FPoints: array[0..1] of TPoint;
    function GetPoint(Index: Integer): TPoint;
    procedure SetPoint(Index: Integer; Value: TPoint);
  protected
    procedure ReadData(Stream: TStream); override;
    procedure WriteData(Stream: TStream); override;
  public  
    constructor Create(AKante: TKante); reintroduce; overload;
    constructor Create(AStart, AStop: TPoint); reintroduce; overload;
    constructor Create(AStartX, AStartY, AStopX, AStopY: Integer); reintroduce; overload;
    destructor Destroy; override;
    procedure Assign(Source: TPersistent); override;
  published
    property Start: TPoint inxex 0 read GetPoint write SetPoint;
    property Stop: TPoint index 1 read GetPoint write SetPoint;
  end;

procedure RegisterBaseClasses(const AClasses: array of TBaseClass);
function GetBaseClass(const AClassName: String): TBaseClass;

procedure SaveList(List: TList; Stream: TStream); // besser ist es eine eigene TList abzuleiten die nur TBaseClass enthalten kann
procedure LoadList(List: TList; Stream: TStream);

implementation

var
  FClassList: TList = nil;

procedure RegisterBaseClasses(const AClasses: array of TBaseClass);
var
  I: Integer;
begin
  Assert(FClassList <> nil);

  for I := Low(AClasses) to High(AClasses) do
    if not (AClasses[I] is TBaseClass) then 
      raise Exception.Create('ungültige Klasse in RegisterBaseClasses') 
    else
      if GetBaseClass(AClasses[I].ClassName) <> nil then 
        raise Exception.CreateFmt('eine Klasse mit Namen "%s" ist schon registriert', [AClasses[I].ClassName]) 
      else 
        FClassList.Add(AClasses[I]);
end;

function GetBaseClass(const AClassName: String): TBaseClass;
var
  I: Integer;
begin
  Assert(FClassList <> nil);

  Result := nil;
  for I := 0 to FClassList.Count -1 do
    if AnsiCompareText(AClassName, TClass(FClassList[I]).ClassName) = 0 then
    begin 
      Result := FClassList[I];
      Break;
    end;
end;

procedure SaveList(List: TList; Stream: TStream); 
var
  I: Integer;
begin
  for I := 0 to List.Count -1 do
    TBase(List[I]).SaveToStream(Stream);
end;

procedure LoadList(List: TList; Stream: TStream);
begin
  while Stream.Position < Stream.Size do
    List.Add(TBase.LoadFromStream(Stream));
end;


// .TBase
procedure TBase.Changed; 
begin
  // hier zb. ein NotifyEvent einbauen
end;

class function TBase.LoadFromStream(Stream: TStream): TBase; 
var
  NewClass: TBaseClass;
  NewName: ShortString;
begin
  Stream.Read(NewName[0], 1);
  Stream.Read(NewName[1], Ord(NewName[0]));
  NewClass := GetBaseClass(NewName);
  if NewClass = nil then
    raise Exception.CreateFmt('Klasse "%s" ist nicht registriert', [NewName]);
  Result := NewClass.Create;
  Result.ReadData(Stream); 
end;

procedure TBase.SaveToStream(Stream: TStream);
var
  NewName: ShortString;
begin
  NewName := ClassName;
  Stream.Write(NewName[0], Ord(NewName[0]) +1);
  WriteData(Stream);
end;

// .TPoint
procedure TPoint.SetX(Value: Integer);
begin
  if Value <> FX then
  begin
    FX := Value;
    Changed;
  end;
end;

procedure TPoint.SetY(Value: Integer);
begin
  if Value <> FY then
  begin
    FY := Value;
    Changed; 
  end;
end;

procedure TPoint.ReadData(Stream: TStream);
begin
  Stream.Read(FX, SizeOf(FX));
  Stream.Read(FY, SizeOf(FY));
end;

procedure TPoint.WriteData(Stream: TStream); 
begin
  Stream.Write(FX, SizeOf(FX));
  Stream.Write(FY, SizeOf(FY));
end;

constructor TPoint.Create(APoint: TPoint); 
begin
  inherited Create;
  Assign(APoint);
end;

constructor TPoint.Create(AX, AY: Integer);
begin
  inherited Create;
  X := AX;
  Y := AY;
end;

procedure TPoint.Assign(Source: TPersistent);
var
  S: TPoint absolute Source;
begin
  if Source is TPoint then
  begin
    if (FX <> S.FX) or (FY <> S.Y) then
    begin
      FX := S.FX;
      FY := S.FY;
      Changed;
    end;
  end else 
    if Source = nil then // bedeutet TPoint(nil) == TPoint(0,0) und ist eine Definitionssache des Programmierers
    begin
      if FX or FY <> 0 then // effizienter! als if (FX <> 0) or (FY <> 0) then
      begin
        FX := 0;
        FY := 0;
        Changed; 
      end;
    end else inherited Assign(Source);
end;

// .TKante
function TKante.GetPoint(Index: Integer): TPoint;
begin
  if FPoints[Index] = nil then 
    FPoints[Index] := TPoint.Create; // Auto-Allokation beim Zugriff auf Start oder Stop
  Result := FPoints[Index];
end;

procedure TKante.SetPoint(Index: Integer; Value: TPoint);
begin
  GetPoint(Index).Assign(Value); // WICHTIG! niemals ein Object setzen sondern immer dessen EIgenschaften kopieren
end;

procedure TKante.ReadData(Stream: TStream); 
begin
// hier gibt es 2 Möglichkeiten

// 1. die TPoint aus Stream als Objekte laden also NEU erzeugen
  FreeAndNil(FPoints[0]);
  FreeAndNil(FPoints[1]); 
  FPoints[0] := TPoint.LoadFromStream(Stream) as TPoint;
  FPoints[1] := TPoint.LoadFromStream(Stream) as TPoint;

// 2. nur die Koordinaten der Points laden
  Start.ReadData(Stream);
  Stop.ReadData(Stream);
// Vorteil: wir sparen die beiden String "TPoint" im Stream
// Nachteil: die beien Punkte Start,Stop müssen IMMER vom Typ TPoint sein
// eine TKante mit 3D Koordinaten könnte von TKante abgeleitet sein aber statt TPoint dann TPoint3D benutzen. 
// Diese TPoint3D Klasse hätte also X,Y,Z
// Für eine der beiden Methoden musst du dich entscheiden
end;
  
procedure TKante.WriteData(Stream: TStream);
begin
// 1. Methode, Klasse mit Daten
  Start.SaveToStream(Stream);
  Stop.SaveToStream(Stream);
// 2. Methode, nur Daten 
  Start.SaveData(Stream);
  Stop.SaveData(Stream);
end;

procedure TKante.Assign(Source: TPersistent); 
begin
  if Source is TKante then
  begin
    Start.Assign(TKante(Source).Start);
    Stop.Assign(TKante(Source).Stop);
    Changed;
  end else
    if Source = nil then
    begin
      FreeAndNil(FPoints[0]);
      FreeAndNil(FPoints[1]);
      Changed;
    end else inherited Assign(Source);
end;

constructor TKante.Create(AStart,AStop: TPoint); 
begin
  inherited Create;
  Start := AStart;
  Stop := AStop;
end;

constructor TKante.Create(AStartX,AStartY,AStopX,AStopY: Integer); 
begin
  inherited Create;
  Start.X := AStartX;
  Start.Y := AStartY;
  Stop.X := AStopX;
  Stop.Y := AStopY; 
end;

constructor TKante.Create(AKante: TKante);
begin
  inherited Create;
  Assign(AKante);
end;

destructor TKante.Destroy;
begin
  FreeAndNil(FPoints[0]);
  FreeAndNil(FPoints[1]); 
  inherited Destroy;
end;

initialization
  FClassList := TList.Create; 
  RegisterBaseClasses([TPoint, TKante]);
finalization
  FreeAndNil(FClassList);
end.

So wie immer keine Gewähr da ich das alles aus dem Stegreif geschrieben habe ohne es jetzt in Delphi zu testen.

Gruß Hagen