TCollection und TCollectionItem

[Jens Schumann]

Liebe Codelib-Manager,
es ist fertig.
Die unit dpCollection.pas enthält die Klassen TJsCollection und TmxJsCollection
Mit diesen Klassen in der Kombination mit Nachfahren von TCollectionItem
lassen sich n-dimsionale "Array's" aufbauen. Je ein TCollectionItem Nachfahre bildet ein Element. Die
Werte die in dem "Array" gespeichert werden sind dann die published properties der TCollectionItem Nachfahren.
Bislang ist das noch nichts besonderes. Aber die Daten lassen mit einem einfachen "SaveToStream" speichern
und mit einem "LoadFromStream" wieder laden. D.h. ein "Arrayelement" kann ein TBitmap, eine TJsCollection (für die
nächste Dimension), Integers, Strings oder TStrings enthalten. Solange die Dinger als published properties
deklariert sind, werden sie automatisch gespeichert. Die beiden TCollection Nachfahren machen sich hier das
Delphi-Streamingsystem zu nutze. Das ist das gleiche Teil das dafür sorgt, dass die Eigenschaften, die über den
Objektinspektor eingestellt werden in der dfm-Datei landen.

TJsCollection implementiert die gundlegenden Methoden wie:
- LoadFromStream
- LoadFromFile
- SaveToStream
- SaveToFile
TJsCollection speichert immer im Binärformat

TmxJsCollection führt die Property Binary ein.
Wenn Binary auf False gesetzt wird, werden die Daten im Textformat gespeichert.
Dei Datei hat den Aufbau einer dfm-Datei (im Textformat).


Das Beispielprogramm (siehe TestApp.jpg oder TestApp.ppt) baut ein 2 dimensionales
Array (siehe CollectionItems.gif oder CollectionItems.ppt) auf.
Die Dateien befinden sich alle in der zip-Datei.


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 den Versionen (D5/D7) gelesen werden.

Gruß
Maximov und Jens

[Jens Schumann]

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 = '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.

[sakura]

Von maximov erreichte uns folgende Ergänzung:


Nachtrag zur dpCollection technik:

Absofort kann man mit BinE binäre DFMs genau so gut wie text-DFMs editieren: http://www.delphipraxis.net/internal...ct.php?t=37128


***

dpCollection template!

Templates bieten eine gute möglichkeit typisierte listen und ähnliches zu benutzen und sind somit ein ersatz für generische typen, der aber recht effektiv ist. Es entfallen somit jegliche Casts und fehler, die auf falschen Casts beruhen . Leider bietet delphi nur über umwege die möglichkeit, dies umzusetzen.

Hier wird beschrieben, wie es funktioniert: http://www.dummzeuch.de/delphi/objec...s/deutsch.html

und hier das template für die die dpCollection.pas:

Delphi-Quellcode:

$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}

Eine mögliche verwendung könnte so aussehen:

Delphi-Quellcode:

...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}

...

Die collectionklassen TTypedCollection würde somit nach aussen so aussehen, als ob sie explizit für den item-typ TmxCustomItem programmiert worden wäre, was natürlich nicht der fall ist.

Konstrukte folgender art sind somit sofort möglich:

Delphi-Quellcode:

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

Was normalerweise völlig ausgeschlossen wäre

viel spass,
Maximov.