Delphi-PRAXiS - Delphi Klasse TPersistentEx zur Diskussion und Verbesserung

Delphi-PRAXiS (https://www.delphipraxis.net/forum.php)

- Algorithmen, Datenstrukturen und Klassendesign (https://www.delphipraxis.net/78-algorithmen-datenstrukturen-und-klassendesign/)

- - Delphi Klasse TPersistentEx zur Diskussion und Verbesserung (https://www.delphipraxis.net/217065-klasse-tpersistentex-zur-diskussion-und-verbesserung.html)

Klasse TPersistentEx zur Diskussion und Verbesserung

Hallo,

ich verwende häufig einfache Klassen auf Basis von TPersistent mit einfachen Datentypen. Hauptsächlich als Basis für Assign und Streamen. Da ich die Assign- und Streeaming Methoden immer manuell erstellen musste habe ich mir beiliegende Klasse TPersistenEx ausgedacht.

Ich bitte Interessierte um Kommentar und Optimierungsvorschläge.

Beispielcode zur Verwendung:

Delphi-Quellcode:

			  TTestObject1 = Class(TPersistentEx)

  private

    FRechner: Double;

  published

    property Rechner: Double read FRechner write FRechner;

  End;

  TTestObject2 = Class(TPersistentEx)

  private

    FName: String;

    FAlter: Integer;

    FTestObject1: TTestObject1;

  public

    constructor Create;

    destructor Destroy; override;

  published

    property Name: String read FName write FName;

    property Alter: Integer read FAlter write FAlter;

    property TestObject1: TTestObject1 read FTestObject1 write FTestObject1;

  End;

procedure TForm1.Button3Click(Sender: TObject);

var

  TestObject : TTestObject2;

  TestObject2 : TTestObject2;

  m : TMemoryStream;

begin

  TestObject := TTestObject2.Create;

  TestObject2 := TTestObject2.Create;

  m := TMemoryStream.Create;

  try

    with TestObject do begin

       FTestObject1.Rechner := 99.7;

       FName := 'Hallo';

       FAlter := 45;

    end;

    with TestObject2 do begin

       FTestObject1.Rechner := -6.7;

       FName := '';

       FAlter := -1;

    end;

    TestObject.AssignTo(TestObject2);

    TestObject.ToStream(m);

    m.Position := 0;

    TestObject2.FromStream(m);

  finally

    m.Free;

    TestObject.Free;

    TestObject2.Free;

  end;

end;

Zusätzlich noch die Frage weiß jemand wie man

Delphi-Quellcode:

If (Object is TPersistentExList<T : TPersistentEx, constructor>) ...

lösen kann?

Grüße Michael

AW: Klasse TPersistentEx zur Diskussion und Verbesserung

Hallo,

erster Fehler, geht nur wenn property read und write hat, anbei Korrektur, diese übergeht read oder write only.

Grüße Michael

AW: Klasse TPersistentEx zur Diskussion und Verbesserung

Hallo,

zweite Berichtigung

Grüße Michael

AW: Klasse TPersistentEx zur Diskussion und Verbesserung

Hallo,

ich habe die Klasse erweitert, Es werden nun auch dynamische Array unterstützt und toXML und fromXML hinzugefügt.

Die Basis für XML ist VerySimpleXML v2.0.5 von Dennis Spreen

https://github.com/Dennis1000/verysimplexml

Delphi-Quellcode:

			type

  TTestObject1 = Class(TPersistentEx)

  private

    FRechner: Double;

  published

    property Rechner: Double read FRechner write FRechner;

  End;

  TTestObject2 = Class(TPersistentEx)

  private

    FName: String;

    FAlter: Integer;

    FTestObject1: TTestObject1;

    FGetTest: String;

    Fcolor: COLORREF;

    FtestDWord: DWORD;

    Ftestp: UIntPtr;

    FArrTest: TArray<String>;

    FArrTestI: TArray<Integer>;

    function GetTest: String;

    procedure SetTest(const Value: String);

  public

    constructor Create;

    destructor Destroy; override;

  published

    property Name: String read FName write FName;

    property Alter: Integer read FAlter write FAlter;

    property TestObject1: TTestObject1 read FTestObject1;

    property MyGetTest: String read GetTest write SetTest;

    property color : COLORREF read Fcolor write Fcolor;

    property testDWord : DWORD read FtestDWord write FtestDWord;

    property testp : UIntPtr read Ftestp write Ftestp;

    property ArrTest: TArray<String> read FArrTest write FArrTest;

    property ArrTestI: TArray<Integer> read FArrTestI write FArrTestI;

  End;

procedure TForm1.Button3Click(Sender: TObject);

var

  MyTestObject : TTestObject2;

  MyTestObject2 : TTestObject2;

  MyTestObject3 : TTestObject2;

  MyTestObject4 : TTestObject2;

  m : TMemoryStream;

  xml : TXmlVerySimple;

begin

  MyTestObject := TTestObject2.Create;

  MyTestObject2 := TTestObject2.Create;

  MyTestObject3 := TTestObject2.Create;

  MyTestObject4 := TTestObject2.Create;

  m := TMemoryStream.Create;

  xml := TXmlVerySimple.Create;

  try

    with MyTestObject do begin

       FTestObject1.Rechner := 99.7;

       FName := 'Hallo';

       FAlter := 45;

       MyGetTest := 'getTest';

       FColor := 99;

       FtestDWord := 123;

       FTestP := Cardinal(@MyTestObject);

       SetLength(FArrTest,5);

       FArrTest[0] := 'Hallo';

       FArrTest[4] := 'ts'',,c hau';

       SetLength(FArrTestI,6);

       FArrTestI[0] := 786;

       FArrTestI[4] := 985;

    end;

    with MyTestObject2 do begin

       FTestObject1.Rechner := -6.7;

       FName := '';

       FAlter := -1;

    end;

    MyTestObject.AssignTo(MyTestObject2);

    MyTestObject.ToStream(m);

    m.Position := 0;

    MyTestObject3.FromStream(m);

    MyTestObject.ToXML('MyTestObject', xml);

    MyTestObject4.FromXML('MyTestObject', xml);

    xml.SaveToFile('r:\Test.xml');

  finally

    m.Free;

    MyTestObject.Free;

    MyTestObject2.Free;

    MyTestObject3.Free;

    MyTestObject4.Free;

  end;

end;

Grüße Michael

AW: Klasse TPersistentEx zur Diskussion und Verbesserung

Hallo,

für xml für erweiterte Datentypen noch TCustomAttribute eingeführt.

Delphi-Quellcode:

			type

  TTestObject1 = Class(TPersistentEx)

  private

    FRechner: Double;

  published

    property Rechner: Double read FRechner write FRechner;

  End;

  TTestObject2 = Class(TPersistentEx)

  private

    FName: String;

    FAlter: Integer;

    FTestObject1: TTestObject1;

    FGetTest: String;

    Fcolor: COLORREF;

    FtestDWord: DWORD;

    Ftestp: UIntPtr;

    FArrTest: TArray<String>;

    FArrTestI: TArray<Integer>;

    FArrTestP: TArray<TAcPattern>;

    FDateTime: TDateTime;

    FIsBoolean: Boolean;

    function GetTest: String;

    procedure SetTest(const Value: String);

  public

    constructor Create;

    destructor Destroy; override;

    property ArrTestP: TArray<TAcPattern> read FArrTestP write FArrTestP;

  published

    property Name: String read FName write FName;

    property Alter: Integer read FAlter write FAlter;

    property TestObject1: TTestObject1 read FTestObject1;

    property MyGetTest: String read GetTest write SetTest;

    [xmlFlags(0, [xfdtHex])]

    property color : COLORREF read Fcolor write Fcolor;

    property testDWord : DWORD read FtestDWord write FtestDWord;

    property testp : UIntPtr read Ftestp write Ftestp;

    property ArrTest: TArray<String> read FArrTest write FArrTest;

    property ArrTestI: TArray<Integer> read FArrTestI write FArrTestI;

    [xmlFlags('22.04.2025 08:00:09', [xfdtDateTime])]

    property DateTime: TDateTime read FDateTime write FDateTime;

    [xmlFlags(True, [xfdtBoolean])]

    property IsBoolean: Boolean read FIsBoolean write FIsBoolean;

  End;

procedure TForm1.Button3Click(Sender: TObject);

var

  MyTestObject : TTestObject2;

  MyTestObject2 : TTestObject2;

  MyTestObject3 : TTestObject2;

  MyTestObject4 : TTestObject2;

  m : TMemoryStream;

  xml : TXmlVerySimple;

begin

  MyTestObject := TTestObject2.Create;

  MyTestObject2 := TTestObject2.Create;

  MyTestObject3 := TTestObject2.Create;

  MyTestObject4 := TTestObject2.Create;

  m := TMemoryStream.Create;

  xml := TXmlVerySimple.Create;

  try

    with MyTestObject do begin

       FTestObject1.Rechner := 99.7;

       FName := 'Hallo';

       FAlter := 45;

       MyGetTest := 'getTest';

       FColor := 99;

       FtestDWord := 123;

       FTestP := Cardinal(@MyTestObject);

       SetLength(FArrTest,5);

       FArrTest[0] := 'Hallo';

       FArrTest[4] := 'ts'',,c hau';

       SetLength(FArrTestI,6);

       FArrTestI[0] := 786;

       FArrTestI[4] := 985;

       DateTime := Now;

    end;

    with MyTestObject2 do begin

       FTestObject1.Rechner := -6.7;

       FName := '';

       FAlter := -1;

    end;

    MyTestObject.AssignTo(MyTestObject2);

    MyTestObject.ToStream(m);

    m.Position := 0;

    MyTestObject3.FromStream(m);

    MyTestObject.ToCfgXML('MyTestObject', xml);

    xml.SaveToFile('r:\TestCg.xml');

    MyTestObject4.FromCfgXML('MyTestObject', xml);

    xml.SaveToFile('r:\Test.xml');

  finally

    m.Free;

    MyTestObject.Free;

    MyTestObject2.Free;

    MyTestObject3.Free;

    MyTestObject4.Free;

  end;

end;

Grüße Michael

AW: Klasse TPersistentEx zur Diskussion und Verbesserung

Hallo,

hier die vorerst letzte Version V1.0ß mit der Bitte um Test und Rückmeldung.

Delphi-Quellcode:

			 Type

  TAcColor = Class(TPersistentEx)

  private

    FRed: Integer;

    FGreen: Integer;

    FBlue: Integer;

  published

    property Red: Integer read FRed write FRed;

    property Green: Integer read FGreen write FGreen;

    property Blue: Integer read FBlue write FBlue;

  End;

  TAcPattern  = Class(TPersistentEx)

  private

    FColor: TAcColor;

    FRaster: Integer;

  published

    constructor Create;

    destructor Destroy; override;

    property Color: TAcColor read FColor write FColor;

    property Raster: Integer read FRaster write FRaster;

  End;

  TStatArrayI = array[0..5,0..5]of Integer;

  TStatArrayS = array[0..5,0..5]of String;

  TStatartray = Array[0..2] of Integer;

  TTestObject2 = Class(TPersistentEx)

  private

    FName: String;

    FAlter: Integer;

    FTestObject1: TTestObject1;

    FGetTest: String;

    Fcolor: COLORREF;

    FtestDWord: DWORD;

    Ftestp: UIntPtr;

    FArrTest: TArray<String>;

    FArrTestI: TArray<Integer>;

    FArrTestP: TArray<TAcPattern>;

    FDateTime: TDateTime;

    FIsBoolean: Boolean;

    FObjectList: TPersistentExList;

    FObjectListArray: TArray<TPersistentExList>;

    function GetTest: String;

    procedure SetTest(const Value: String);

  public

    constructor Create;

    destructor Destroy; override;

  published

    property ObjectList: TPersistentExList read FObjectList write FObjectList;

    property ArrTestI: TArray<Integer> read FArrTestI write FArrTestI;

    property ArrTestP: TArray<TAcPattern> read FArrTestP write FArrTestP;

    property ArrTest: TArray<String> read FArrTest write FArrTest;

    property ObjectListArray: TArray<TPersistentExList> read FObjectListArray write FObjectListArray;

    property Name: String read FName write FName;

    property Alter: Integer read FAlter write FAlter;

    property TestObject1: TTestObject1 read FTestObject1 write FTestObject1;

    property MyGetTest: String read GetTest write SetTest;

    [xmlFlags(0, [xfdtHex])]

    property color : COLORREF read Fcolor write Fcolor;

    property testDWord : DWORD read FtestDWord write FtestDWord;

    property testp : UIntPtr read Ftestp write Ftestp;

    [xmlFlags('22.04.2025 08:00:09', [xfdtDateTime])]

    property DateTime: TDateTime read FDateTime write FDateTime;

    [xmlFlags(True, [xfdtBoolean])]

    property IsBoolean: Boolean read FIsBoolean write FIsBoolean;

  End;

procedure TForm1.Button3Click(Sender: TObject);

procedure doi(const AObject : String; const AAcPattern : TPersistentEx);

begin

   memo1.Lines.Add(Format('%s = %d',[AObject, TAcPattern(AAcPattern).FRaster]));

end;

var

  MyTestObject : TTestObject2;

  MyTestObject2 : TTestObject2;

  MyTestObject3 : TTestObject2;

  MyTestObject4 : TTestObject2;

  m : TFileStream;

  xml : TXmlVerySimple;

begin

  MyTestObject :=  TTestObject2.Create;

  MyTestObject2 := TTestObject2.Create;

  MyTestObject3 := TTestObject2.Create;

  MyTestObject4 := TTestObject2.Create;

  m := TFileStream.Create('r:\test.strm', fmCreate);

  xml := TXmlVerySimple.Create;

  try

    with MyTestObject do begin

       FTestObject1.Rechner := 99.7;

       FName := 'Hallo';

       FAlter := 45;

       MyGetTest := 'getTest';

       FColor := 99;

       FtestDWord := 123;

       FTestP := Cardinal(@MyTestObject);

       SetLength(FArrTest,5);

       FArrTest[0] := 'Hallo';

       FArrTest[4] := 'ts'',,c hau';

       SetLength(FArrTestI,6);

       FArrTestI[0] := 786;

       FArrTestI[4] := 985;

       DateTime := Now;

       SetLength(FArrTestP, 5);

       FArrTestP[2] := TAcPattern.Create;

       FArrTestP[2].FColor := TAcColor.Create;

       FArrTestP[2].FRaster := 8;

       SetLength(FObjectListArray, 5);

       FObjectListArray[4] := TPersistentExList.Create(True);

       var i := FObjectListArray[4].Add(TAcPattern.Create);

       TAcPattern(FObjectListArray[4][i]).FRaster := 956;

       i := FObjectListArray[4].Add(TAcPattern.Create);

       TAcPattern(FObjectListArray[4][i]).FRaster := 1234;

       IsBoolean := True;

    end;

    with MyTestObject2 do begin

       FTestObject1.Rechner := -6.7;

       FName := '';

       FAlter := -1;

    end;

    for var i  := 0 to MyTestObject.ObjectList.Count-1 do doi('ol_'+i.ToString,MyTestObject.ObjectList[i]);

    for var i  := 0 to MyTestObject.ObjectListArray[4].Count-1 do doi('ola4_'+i.ToString,MyTestObject.ObjectListArray[4][i]);

    MyTestObject.AssignTo(MyTestObject2);

    for var i  := 0 to MyTestObject2.ObjectList.Count-1 do doi('ol_'+i.ToString,MyTestObject2.ObjectList[i]);

    for var i  := 0 to MyTestObject2.ObjectListArray[4].Count-1 do doi('ola4_'+i.ToString,MyTestObject2.ObjectListArray[4][i]);

    MyTestObject.AssignTo(MyTestObject2);

    for var i  := 0 to MyTestObject2.ObjectList.Count-1 do doi('ol_'+i.ToString,MyTestObject2.ObjectList[i]);

    for var i  := 0 to MyTestObject2.ObjectListArray[4].Count-1 do doi('ola4_'+i.ToString,MyTestObject2.ObjectListArray[4][i]);

    MyTestObject.ToStream(m);

    m.Position := 0;

    MyTestObject3.FromStream(m);

    for var i  := 0 to MyTestObject3.ObjectList.Count-1 do doi('ol3_'+i.ToString,MyTestObject2.ObjectList[i]);

    for var i  := 0 to MyTestObject3.ObjectListArray[4].Count-1 do doi('ol3a4_'+i.ToString,MyTestObject2.ObjectListArray[4][i]);

    m.Position := 0;

    MyTestObject3.FromStream(m);

    for var i  := 0 to MyTestObject3.ObjectList.Count-1 do doi('ol3_'+i.ToString,MyTestObject2.ObjectList[i]);

    for var i  := 0 to MyTestObject3.ObjectListArray[4].Count-1 do doi('ol3a4_'+i.ToString,MyTestObject2.ObjectListArray[4][i]);

    m.Position := 0;

    MyTestObject2.ToXML('MyTestObject', xml);

    xml.SaveToFile('r:\TestCg.xml');

    MyTestObject4.FromXML('MyTestObject', xml);

    for var i  := 0 to MyTestObject4.ObjectList.Count-1 do doi('ol_'+i.ToString,MyTestObject4.ObjectList[i]);

    for var i  := 0 to MyTestObject4.ObjectListArray[4].Count-1 do doi('ola4_'+i.ToString,MyTestObject4.ObjectListArray[4][i]);

    MyTestObject4.FromXML('MyTestObject', xml);

    for var i  := 0 to MyTestObject4.ObjectList.Count-1 do doi('ol_'+i.ToString,MyTestObject4.ObjectList[i]);

    for var i  := 0 to MyTestObject4.ObjectListArray[4].Count-1 do doi('ola4_'+i.ToString,MyTestObject4.ObjectListArray[4][i]);

    xml.SaveToFile('r:\Test.xml');

  finally

    xml.Free;

    m.Free;

    MyTestObject.Free;

    MyTestObject2.Free;

    MyTestObject3.Free;

    MyTestObject4.Free;

  end;

end;

Grüße Michael

AW: Klasse TPersistentEx zur Diskussion und Verbesserung

Zitat:

Zitat von michaott (Beitrag 1548484)

Hallo,

hier die vorerst letzte Version V1.0ß mit der Bitte um Test und Rückmeldung.

Von mir nur mal soviel:
- Es fehlt die Doku (oder ich finde sie nicht) :-D
- String und Class kleinschreiben.

AW: Klasse TPersistentEx zur Diskussion und Verbesserung

Hallo,

Kurze Doku:

TPersistentEx als Erweiterung für TPersistent für Daten die zugewiesen, gestreamt, oder in xml gespeichert werden sollen.

Die Objekte auf der Basis von TPersistentEx haben ohne weitere Implementation Assign, Streaming und XML-Zuweisungs funktionalität für alle published Deklarierten Propertys. Bei den verwendeten Klassen muss die Basisklasse immer TPersistenEx sein.

Für Listen muss immer TPersistentExList verwendet werden, ansonsten werden keine Listen bearbeitet. Da ich noch keine Funktion zur as is für Generische Klassen (z.B. TPersistentExList<TestObject> is TPersistentExList<TPersistenEx>) gefunden haben muss immer die generische Klasse TPersistentExList = Class(TPersistentExList<TPersistenEx>)) verwendet werden.

Verwendete Klassen müssen mit RegisterClass(TKlassePersistentEx) registriert werden. Ansonsten gibt es eine Exception mit Zugriffsfehler beim Zurücklesen.

Grüße Michael

AW: Klasse TPersistentEx zur Diskussion und Verbesserung

Hallo,

Nachtrag zur Doku:

verwendete Objekte müssen über RegisterClass registriert werden.

z.B. komplettes Unit mit:

Delphi-Quellcode:

			unit UMeineObjekte;

....

procedure RegisterMyClasses;

var

  RttiCtx : TRttiContext;

begin

   RttiCtx := TRttiContext.Create;

   try

      for var t in RttiCtx.GetTypes  do begin

         if t.IsInstance then begin

            var o := t.AsInstance;

            var LUnitName := o.DeclaringUnitName;

            if t.TypeKind = tkClass then begin

               If LUnitName = 'UMeineObjekte' then begin

                  If (TRttiInstanceType(t).MetaclassType.InheritsFrom(TPersistentEx)) then begin

                     RegisterClass(TPersistentClass(TRttiInstanceType(t).MetaclassType));

                  end;

               end;

            end;

         end;

      end;

   finally

      RttiCtx.Free;

   end;

end;

initialization

   RegisterMyClasses;

end.

AW: Klasse TPersistentEx zur Diskussion und Verbesserung

Hallo,

Fehler bei ToStream und FromStream

Code:

			825c825

<        if not RttiProp.IsWritable then continue;

---

>        if not (RttiProp.IsWritable and RttiProp.IsReadable) then continue;

1216c1216

<          if not RttiProp.IsReadable then continue;

---

>          if not  (RttiProp.IsWritable and RttiProp.IsReadable) then continue;

Grüße Michael