Klasse TPersistentEx zur Diskussion und Verbesserung

[michaott]

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
   If (Object is TPersistentExList<T : TPersistentEx, constructor>) ... lösen kann?

Grüße Michael

[michaott]

Hallo,

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

Grüße Michael

[michaott]

Hallo,

zweite Berichtigung

Grüße Michael

[michaott]

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

[michaott]

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