Referzen in ein Stream speichern

[negaH]

Tja, hilft wohl nichts man sollte immer auch einen Test des Sources machen. Leider kann ich mir eben nicht ALLES merken und so ist es auch logisch das ein eben mal schnell gehackter Code niemals auf Anhieb funktionieren wird.

Ich werde es also mal selber testen müssen, die Frage ist wann habe ich Zeit dazu

Gruß Hagen

[negaH]

Delphi-Quellcode:

unit Unit2;

interface

uses SysUtils, Classes;

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); reintroduce; overload;
    constructor Create(AX, AY: Integer); reintroduce; 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 index 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].InheritsFrom(TBase) 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
  FreeAndNil(FPoints[0]);
  FreeAndNil(FPoints[1]);
  FPoints[0] := TPoint.LoadFromStream(Stream) as TPoint;
  FPoints[1] := TPoint.LoadFromStream(Stream) as TPoint;
end;
 
procedure TKante.WriteData(Stream: TStream);
begin
  Start.SaveToStream(Stream);
  Stop.SaveToStream(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.

Mit wenigen Änderungen absolut lauffähig

Und ein Testcode

Delphi-Quellcode:

procedure TForm1.Button1Click(Sender: TObject);
var
  List: TList;
  Stream: TMemoryStream;
  I: Integer;
begin
  Stream := TMemoryStream.Create;
  List := TList.Create;
  try
    for I := 0 to 9 do
      List.Add(TPoint.Create(I, I));
    for I := 0 to 9 do
      List.Add(TKante.Create(I, I, I, I));
    SaveList(List, Stream);

    Stream.SaveToFile('c:\test.bin');

    for I := 0 to List.Count -1 do
      TBase(List[I]).Free;
    List.Clear;
    Stream.Position := 0;
    LoadList(List, Stream);
  finally
    List.Free;
    Stream.Free;
  end;
end;

So, das macht aber mindestens 3 Biere, wenn ich den Stoff auf trinken würde

Gruß Hagen

[Geri]

Hallo Hagen

Vielen Dank für das Nachbesseren und das Beispiel. Die drei Biere zahle ich gerne, falls du mal in der Gegend von mir (50. KM südlich) von Lindau am Bodensee bist!

Ich habe den Code nun eingefügt und laufen gelassen, erhalte aber bei Aufruf von Loadlist leider die Meldung:

Klasse '' nicht registriert...


Ausserdem fällt mir auf, dass du
mit

Delphi-Quellcode:

  for I := 0 to 9 do
      List.Add(TPoint.Create(I, I));
    for I := 0 to 9 do
      List.Add(TKante.Create(I, I, I, I));

hier unabhänkgige Objekte anlegst. Meine möchte aber gerne
10 Punkte anlgen und diese dann über Kanten miteinander verlinken, damit man ein Netz abbilden kann (z.B. eine Landkarte). Deshalb habe ich auch


for i:=0 To 4 DO
List.add(TKante.Create(List[Random(9)],List[Random(9)]); geschrieben.

Kante hält dann zwei Referenzen auf Objekte. Deshalb auch die Problematik beim Speichern, weil die Punkte einer Kante ja nur Referenzen auf Objekte darstellen.

..oder habe ich hier etwas vollkommen falsch verstanden oder mich unklar ausgedrückt?


Beste Grüsse und ich werde die Biere auch nicht vergessen

Geri

[negaH]

Shit, das ist aber konzeptionell eine ganz andere Sache als das was durch deine Postings rübergekommen ist.

Tja dann musst du meinen Source wieder abändern denn durch .Assign() usw. wird in meinen TKante sichergestellt das es IMMER eigene Point Objecte enthält. Konzeptionell ist das ein sehr sicherer Weg um logische Fehler die bei verlinkten Objekten entstehen könne (Freigabe, gemeinsamme Verlinkungen etc.pp) zu vermeiden.

Der Fehler "Klasse nicht registrert" kann nur in .LoadFromStream() auftreten weil zb. TPoint nicht mit RegisterBaseClasses() registriert wurde. Wenn du 1 zu 1 meinen Source als Unit und meinen Testcode benutzt hast dann darf KEIN Fehler mehr auftreten. Falls doch ist irgendwo der Wurm drinnen. Welche Delphi Version und welche Compilereinstellungen benutzt du ?

Ist schon komisch weil der Source bei mir nach 3 Minuten und wenigen Änderungen (3 Tippfehler + 1 in RegisterBaseClasses()) ssfort lief.

Schau mal ob du dich durchbeissen kannst, denn nur wenn man es wirklich selber vom Hirn über die Nerven zu den Fingern und dann als Source in den Computer gehackt hat wird man es wirklich lernen.

Gruß Hagen

[Geri]

Hallo negaH

Vielen Dank für Deine Rückmeldung. Ich gebe jetzt vorerste mal auf, weil ich nicht mal weiss, wie ich ansetzen soll und suche mal im Internet nach einem Beispiel. Das ganze entstand auch nur alleine aus Interesse an diesem Problem.

Hagen, jedenfalls vielen Dank für all die Hilfe und falls ich positive Ergebnisse aufzeigen kann, dann werde ich sie hier für andere Posten oder wieder einmal ein Tutorial verfassen.

Geri