//-----------------------------------------------------------------------------
// 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 = 'items' then
    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.

$IFNDEF TYPED_DP_COLLECTION_TEMPLATE}
unit dpCollection_tmpl;

// written by MaxHub (maximov) 10.07.2004

// dpCollection: [url]http://www.delphipraxis.net/topic28945_tcollection+und+tcollectionitem.html[/url]

// thanks to Thomas Mueller for his 'Object Pascal Templates' article
// -> [url]http://www.dummzeuch.de/delphi/object_pascal_templates/deutsch.html[/url]

// thanks to Rossen Assenov for the original narticle 'Templates in Object Pascal'
// -> [url]http://community.borland.com/article/0,1410,27603,00.html[/url]

interface

uses Classes, dpCollection;


type
  _COLLECTION_ITEM_ = TCollectionItem;
{$ENDIF TYPED_DP_COLLECTION_TEMPLATE}

{$IFNDEF TYPED_DP_COLLECTION_TEMPLATE_SECOND_PASS}
type
  _COLLECTION_ = class (TmxJsCollection)
  protected
    function GetItem (const aIndex : Integer) : _COLLECTION_ITEM_;
    procedure SetItem (const aIndex : Integer;
                      const aValue : _COLLECTION_ITEM_);
    
  public
    constructor Create;

    function Add : _COLLECTION_ITEM_;
    function FindItemID (const aID : Integer) : _COLLECTION_ITEM_;
    function Insert (const aIndex : Integer) : _COLLECTION_ITEM_;
    property Items [const aIndex : Integer] : _COLLECTION_ITEM_ read GetItem write SetItem;
  end;


{$ENDIF TYPED_DP_COLLECTION_TEMPLATE_SECOND_PASS}

{$IFNDEF TYPED_DP_COLLECTION_TEMPLATE}
implementation
{$DEFINE TYPED_DP_COLLECTION_TEMPLATE_SECOND_PASS}
{$ENDIF TYPED_DP_COLLECTION_TEMPLATE}

{$IFDEF TYPED_DP_COLLECTION_TEMPLATE_SECOND_PASS}

{ TYPED_DP_COLLECTION }

constructor _COLLECTION_.Create;
begin
 inherited Create(_COLLECTION_ITEM_);
end;

function _COLLECTION_.Add : _COLLECTION_ITEM_;
begin
 Result := _COLLECTION_ITEM_ (inherited Add);
end;

function _COLLECTION_.FindItemID (const aID : Integer) : _COLLECTION_ITEM_;
begin
 Result := _COLLECTION_ITEM_ (inherited FindItemID (aID));
end;

function _COLLECTION_.GetItem (const aIndex : Integer) : _COLLECTION_ITEM_;
begin
 Result := _COLLECTION_ITEM_ (inherited GetItem (aIndex));
end;

function _COLLECTION_.Insert (const aIndex : Integer) : _COLLECTION_ITEM_;
begin
 Result := _COLLECTION_ITEM_ (inherited Insert (aIndex));
end;

procedure _COLLECTION_.SetItem (const aIndex : Integer;
                                const aValue : _COLLECTION_ITEM_);
begin
 inherited SetItem (aIndex, aValue);
end;

{$WARNINGS off}
{$IFNDEF TYPED_DP_COLLECTION_TEMPLATE}
end.
{$ENDIF TYPED_DP_COLLECTION_TEMPLATE}
{$ENDIF TYPED_DP_COLLECTION_TEMPLATE_SECOND_PASS}
{$DEFINE TYPED_DP_COLLECTION_TEMPLATE_SECOND_PASS}

...type
  
  { *** Sample dataformat item object ***}

  TmxCustomItem = class(TCollectionItem)
  private
   ...
  protected

  public
   ...
  published
    // stored properties in variouse data types -- define as much as you need
    property sequence : string read getSequence write SetSequence stored false; // adapter to the binSequence
    property aBoolean : boolean read FaBoolean write FaBoolean;
    property anInteger : integer read FanInteger write FanInteger;
    property anExtended : Extended read FanExtended write FanExtended;
    property anEnum : TFilerFlag read FanEnum write FanEnum;
    property aSet : TFilerFlags read FaSet write FaSet;
    property anImage : TBitmap read FanImage write FanImage stored true;
  end;

    

  {$define TYPED_DP_COLLECTION_TEMPLATE}
type
  _COLLECTION_ITEM_ = TmxCustomItem; // typisierung festlegen
  {$INCLUDE dpCollection_tmpl.pas}   // template inkludieren
  TTypedCollection = _COLLECTION_; // fertige collection sprechenden namen geben

  ...

implementation

{$INCLUDE dpCollection_tmpl.pas}

...

var myCollection:TTypedCollection ;
...
x := myCollection.items[i].anInteger;