AGB  ·  Datenschutz  ·  Impressum  







Anmelden
Nützliche Links
Registrieren
Thema durchsuchen
Ansicht
Themen-Optionen

TCollection und TCollectionItem

Ein Thema von Jens Schumann · begonnen am 5. Jun 2004 · letzter Beitrag vom 18. Okt 2004
Antwort Antwort
Benutzerbild von Jens Schumann
Jens Schumann

Registriert seit: 27. Apr 2003
Ort: Bad Honnef
1.644 Beiträge
 
Delphi 2009 Professional
 
#1

Re: TCollection und TCollectionItem

  Alt 5. Jun 2004, 21:08
Hallo liebe Codelib Manager,
hier ist die unit dpCollection.pas. Maximov hat noch einige
Anpassungen für D8 vorgenommen
Delphi-Quellcode:
//-----------------------------------------------------------------------------
// Unit Name : dpCollection
// Author : Jens Schumann und MaxHub (maximov)
// Copyright : alle
// Purpose : Collection object serialization
// History : 19.05.2004, 08:45 - first blue bord version
// Delphi Version : D5, D7, D8
//-----------------------------------------------------------------------------
//
//-----------------------------------------------------------------------------
// Unterschied zwischen D5 und D7
//
// Wenn ein TCollectionItem eine TJsCollection oder TmxJsCollection property
// hat (In diesen Beispiel wäre das die TD7CollectionItem Property Numbers in
// der unit collectionitems_impl), so werden deren published properties nicht
// von D5 gestreamt.
// Es können die Dateien aber von beiden Versionen (D5/D7) gelesen werden.
//
//-----------------------------------------------------------------------------

unit dpCollection;

interface

Uses SysUtils, Classes;

Type

  TJsCollection = class(TCollection)
  private
    FCollectionname : String;
    procedure SetCollectionname(const Value: String);
    function getCollectionname: String;
  public
    procedure Assign(Source : TPersistent); override;
    procedure SaveToFile(const Filename : TFilename);
    procedure SaveToStream(Stream : TStream); virtual;
    procedure LoadFromFile(const Filename : TFilename);
    procedure LoadFromStream(Stream : TStream); virtual;
  published
   
  published
    property Collectionname : String read getCollectionname write SetCollectionname;
  end;

  TmxJsCollection = class(TJsCollection)
  private
    FBinary : Boolean;
  public
    procedure LoadFromStream(aStream: TStream); override;
    procedure SaveToStream(aStream: TStream); override;
    // binary ist beim laden der indikator ob es ein binär oder text stream war,
    // und beim speichern welches das ziel-format sein soll.
    property Binary : Boolean read FBinary write FBinary;
  published
    property Collectionname stored false;
  end;
     

  TWriterExt = class(TWriter)
  public
    procedure WriteCollectionProperties(Value : TCollection);
  end;

  TReaderExt = class(TReader)
  public
    procedure ReadCollectionProperties(Value: TCollection);
  end;


implementation

uses TypInfo;

const
  iFilerBufferSize = 4096;
  FilerSignatureEx: String = 'TPF0';
  cInvalidName = ' is not a valid CollectionName!';

{ TJsCollection }




procedure TJsCollection.Assign(Source: TPersistent);
begin
  If Source is TJsCollection then
    FCollectionname:=TJsCollection(Source).Collectionname;
  inherited Assign(Source);
end;

function TJsCollection.GetCollectionname: String;
begin
  if FCollectionname = ''
  then result := copy(className,2,length(className)-1)
  else result := FCollectionname;
end;

procedure TJsCollection.LoadFromFile(const Filename: TFilename);
var
  FileStream : TFileStream;
begin
  Clear;
  FileStream:=TFileStream.Create(Filename,fmOpenRead);
  Try
    LoadFromStream(FileStream);
  Finally
    FileStream.Free;
    end;
end;

procedure TJsCollection.LoadFromStream(Stream: TStream);
var
  Reader : TReaderExt;
begin
  Reader:=TReaderExt.Create(Stream,iFilerBufferSize);
  Try
    Reader.ReadCollectionProperties(Self);
  Finally
    Reader.Free;
    end;
end;

procedure TJsCollection.SaveToFile(const Filename: TFilename);
var
  FileStream : TFileStream;
begin
  FileStream:=TFileStream.Create(Filename,fmCreate);
  Try
    SaveToStream(FileStream);
  Finally
    FileStream.Free;
    end;
end;

procedure TJsCollection.SaveToStream(Stream: TStream);
var
  Writer : TWriterExt;
begin
  Writer:=TWriterExt.Create(Stream,iFilerBufferSize);
  Try
    Writer.WriteCollectionProperties(Self);
    Writer.WriteListEnd;
  Finally
    Writer.Free;
    end;
end;

procedure TJsCollection.SetCollectionname(const Value: String);
begin
  if not IsValidIdent(Value)
  then raise exception.Create(#39+Value+#39+cInValidName)
  else FCollectionname := Value;
end;

{ TWriterExt }


procedure TWriterExt.WriteCollectionProperties(Value: TCollection);
begin
  WriteProperties(Value);
  WriteStr('items');
  inherited WriteCollection(Value);
end;

{ TReaderExt }

procedure TReaderExt.ReadCollectionProperties(Value: TCollection);
var propName:string;
    oldPos:integer;
begin
  while not EndOfList do
  begin
    oldPos := Position;
    propName := ReadStr;
    if propName = 'itemsthen
    begin
      ReadValue;
      inherited ReadCollection(Value);
    end else begin
      Position := oldPos;
      ReadProperty(value);
    end;
  end;
end;


{ TmxJsCollection }

procedure TmxJsCollection.LoadFromStream(aStream: TStream);
var Reader : TReaderExt;
    StreamInner : TStream;
    format : TStreamOriginalFormat;
    oldPos : Int64;
    SigBuffer : array[1..4] of char;
begin
  // automatisch feststellen ob binär oder text
  oldPos := aStream.Position;
  aStream.ReadBuffer(SigBuffer[1],sizeOf(SigBuffer));
  FBinary := SigBuffer = FilerSignatureEx;
  aStream.Position := oldPos;

  if FBinary
  then StreamInner := aStream
  else StreamInner := TMemoryStream.Create;
             
  try
    // DFM-text parsen
    if not FBinary then
    begin
      format := sofBinary;
      ObjectTextToBinary(aStream,StreamInner,format);
      StreamInner.Position := 0;
    end;
                         
    Reader := TReaderExt.Create(StreamInner,iFilerBufferSize);
    try
      Reader.ReadSignature;
      Reader.ReadStr; // ClassName
      FCollectionname := Reader.ReadStr; // Collectionname

      Reader.ReadCollectionProperties(self);

      Reader.ReadListEnd;
      Reader.ReadListEnd;
    finally
      Reader.Free;
    end;
  finally
    if not FBinary then StreamInner.Free;
  end;
end;


procedure TmxJsCollection.SaveToStream(aStream: TStream);
var Writer : TWriterExt;
    StreamInner : TStream;
    format : TStreamOriginalFormat;
begin
  if FBinary
  then StreamInner := aStream
  else StreamInner := TMemoryStream.Create;
               
  try
    Writer := TWriterExt.Create(StreamInner,iFilerBufferSize);
    try
      Writer.WriteSignature;
      Writer.WriteStr(ClassName);
      Writer.WriteStr(Collectionname);

      Writer.WriteCollectionProperties(self);
     
      Writer.WriteListEnd;
      Writer.WriteListEnd;
    finally
      Writer.Free;
    end;
    // DFM-text konversion
    if not FBinary then
    begin
      StreamInner.Position := 0;
      format := sofText;
      ObjectBinaryToText(StreamInner,aStream,format);
    end;
  finally
    if not FBinary then StreamInner.Free;
  end;
end;

end.
I come from outer space to save the human race
  Mit Zitat antworten Zitat
Antwort Antwort

Forumregeln

Es ist dir nicht erlaubt, neue Themen zu verfassen.
Es ist dir nicht erlaubt, auf Beiträge zu antworten.
Es ist dir nicht erlaubt, Anhänge hochzuladen.
Es ist dir nicht erlaubt, deine Beiträge zu bearbeiten.

BB-Code ist an.
Smileys sind an.
[IMG] Code ist an.
HTML-Code ist aus.
Trackbacks are an
Pingbacks are an
Refbacks are aus

Gehe zu:

Impressum · AGB · Datenschutz · Nach oben
Alle Zeitangaben in WEZ +1. Es ist jetzt 20:12 Uhr.
Powered by vBulletin® Copyright ©2000 - 2025, Jelsoft Enterprises Ltd.
LinkBacks Enabled by vBSEO © 2011, Crawlability, Inc.
Delphi-PRAXiS (c) 2002 - 2023 by Daniel R. Wolf, 2024-2025 by Thomas Breitkreuz