include(PUN_ROOT.'syn/css.php'); ?>
Sie sind nicht angemeldet.
dpCollection - Collection serialisieren
-> Diese klassen sind in zusammenarbeit mit Jens Schuhmann und mir, in der DelphiPraxis entstanden.
-> http://www.delphipraxis.net/topic28945_tcollection+und+tcollectionitem.html
-> Wir erteilen hiermit allen mitgliedern von DelphiDev.de die uneingeschränkte nutzung der dpCollection.pas!
---
Mit der klasse TmxJsCollection und TJsCollection ist es möglich serielle datenstrukturen, jeglicher typen und komplexität, zu streamen. Hierzu wird das Delphi-component-streaming-system benutzt, kombiniert mit einem kleinen fake-trick. Dabei kann im binär format, als auch im text-dfm format gespeichert werden!
Dazu stehen folgende methoden zur verfügung:
procedure savetofile(const filename : tfilename); procedure savetostream(stream : tstream); virtual; procedure loadfromfile(const filename : tfilename); procedure loadfromstream(stream : tstream); virtual;
Bei verwendung dieser methoden werden alle Items, einer selbst abgeleiteten TCollectionItem klasse automatisch gespeichert oder geladen. Beim laden werden die items automatisch instanziert und deren published properties gesetzt. Beim speichern werden alle published properties verwendet, bei denen der wert vom default-wert abweicht - bzw. nicht stored false ist - bzw. die nicht readOnly sind.
Diese beispiel klasse...
tmxcustomitem = class(tcollectionitem) private ... published property aboolean : boolean read faboolean write faboolean; property aninteger : integer read faninteger write faninteger; property anotherinteger : integer read fanotherinteger write fanotherinteger default 0; property anextended : extended read fanextended write fanextended; property anenum : tfilerflag read fanenum write fanenum; property aset : tfilerflags read faset write faset; property astring : string read fastring write fastring stored false; end;
...produziert folgenden output:
object mxcustomitems: tmxcollection items = < item aboolean = true aninteger = 5 anotherinteger = 666 anextended = 1.234560000000000000 anenum = ffchildpos aset = [ffchildpos,ffinline] end ... ... ... item aboolean = false aninteger = 3 anextended = 111.000000000000000000 anenum = ffinline aset = [] end> end
Das soll aber nicht heissen, dass man keine normalen properties oder binäre daten speichern kann! Denn zu diesem zweck kann, in der item-klasse, die methode DefineProperties überschrieben werden. Mehr dazu in der Delphi hilfe.
Desweiteren werden auch object properties, die von TPersistent abgeleitet sind, mit qualifizierer (.) geschrieben. und TBitmaps sind auch kein problem, dadurch werden die text-DFMs jedoch sehr gross, deshalb sollte bei grösseren bildern die property Binary true benutzt werden. Text-DFM-streaminng steht nur ab der klasse TmxJsCollection zur verfügung.
Beim instanzieren der Collection wird die eigene item klasse übergeben, wie üblich:
mycollection := tmxcollection.create(tmxcustomitem);
Die benutzung ist sehr einfach und sollte selbsterklärend sein:
mycollection.savetofile('c:/data.dfm'); ... mycollection.loadfromfile('c:/data.dfm');
Alles weitere in der Delphi hilfe unter TCollection.
//----------------------------------------------------------------------------- // 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.
viel spass damit.
Offline