Einzelnen Beitrag anzeigen

michaott

Registriert seit: 14. Nov 2010
15 Beiträge
 
Delphi 12 Athens
 
#6

AW: Klasse TPersistentEx zur Diskussion und Verbesserung

  Alt 7. Mai 2025, 06:08
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
Angehängte Dateien
Dateityp: pas UPersistentEx.pas (51,2 KB, 4x aufgerufen)
  Mit Zitat antworten Zitat