AGB  ·  Datenschutz  ·  Impressum  







Anmelden
Nützliche Links
Registrieren
Zurück Delphi-PRAXiS Programmierung allgemein Algorithmen, Datenstrukturen und Klassendesign Delphi Klasse TPersistentEx zur Diskussion und Verbesserung
Thema durchsuchen
Ansicht
Themen-Optionen

Klasse TPersistentEx zur Diskussion und Verbesserung

Ein Thema von michaott · begonnen am 18. Apr 2025 · letzter Beitrag vom 8. Mai 2025
 
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
 

 

Forumregeln

Es ist dir nicht erlaubt, neue Themen zu verfassen.
Es ist dir nicht erlaubt, auf Beiträge zu antworten.
Es ist dir nicht erlaubt, Anhänge hochzuladen.
Es ist dir nicht erlaubt, deine Beiträge zu bearbeiten.

BB-Code ist an.
Smileys sind an.
[IMG] Code ist an.
HTML-Code ist aus.
Trackbacks are an
Pingbacks are an
Refbacks are aus

Gehe zu:

Impressum · AGB · Datenschutz · Nach oben
Alle Zeitangaben in WEZ +1. Es ist jetzt 13:39 Uhr.
Powered by vBulletin® Copyright ©2000 - 2025, Jelsoft Enterprises Ltd.
LinkBacks Enabled by vBSEO © 2011, Crawlability, Inc.
Delphi-PRAXiS (c) 2002 - 2023 by Daniel R. Wolf, 2024-2025 by Thomas Breitkreuz