Código Delphi [-]

Clase A
==============
prop1: integer
prop2: integer
prop3:string
prop4: List of ClaseB
...

Clase B
=============
prop1: boolean
prop2: string
prop3: integer
prop4: List of claseC
...

Clase C
==============
prop1: List of Tpoint
prop2:Tcolor
...

Código Delphi [-]
writeln('NombrePropiedadN');
writeln(PropiedadN);
writeln('NombrePropiedadN');
writeln('NombrePropiedadMTipoRegistro');
writeln('NombreCampoZDeLaPropiedadMdeTipoRegistro');
write(PropiedadMTipoRegistro.CampoZ);

Código Delphi [-]
XMLParser.writeNode(NombreEtiqueta, Valor);

• Alguna de las clases han pasado a derivar de TCollectionItem y otras de TCollection, básicamente para cambiar las lista con la que anteriormente trabajaba por colecciones. Ha afectado muy poco a la implementación, ya que sólo he tenido que cambiar algun método de acceso.
• Las propiedades definidas en las clases que queremos almacenar hay que pasarlas de la sección public a la sección published.
• La clase principal deriva ahora de TComponent para poder añadirle “persistencia”.
• Como ya he comentado, algunos pequeños cambios en la implementación, necesarios para adecuar código a los cambios de definición, pero que no han sido nada importantes.
• Por último añadir el registro de las clase utilizando el procedimiento RegisterClass.

Código Delphi [-]
  TTrackData = class;
  TPointInfo = class;
  TTrack = class;

  {Clase para encapsular la información de un punto.}
  TPointInfo = class(TCollectionItem)
  private
    FEle: string;
    FLon: string;
    FLat: string;
    FTime: string;
    FLatF: Double;
    FLonF: Double;
  public
    // constructor de la clase
    constructor Create(ACol:TCollection; ALat, ALon, AEle, ATime: string;
                       ALatF, ALonF : Double); overload; virtual;

    function _debug(TS:TStrings):string; virtual;
  published
    property Lat:string read FLat write FLat;
    property Lon:string read FLon write FLon;
    property Ele:string read FEle write FEle;
    property Time:string read FTime write FTime;

    property LatF : Double read FLatF write FLatF;
    property LonF : Double read FLonF write FLonF;
  end;

  {: Clase para encapsular la información de un WayPoint.}
  TWayPoint = class(TPointInfo)
  private
    FNombre: string;
    FDesc: string;
    FSimbolo: string;
  public
    // constructor de la clase
    constructor Create(ATrack:TTrackData;
                       AWPNombre, AWPDesc:string;
                       ASimbolo:string;
                       ALat, ALon, AEle, ATime: string;
                       ALatF, ALonF: Double); overload;

    function _debug(TS:TStrings):string; override;
  published
    property Nombre:string read FNombre write FNombre;
    property Desc:string read FDesc write FDesc;
    property Simbolo:string read FSimbolo write FSimbolo;
  end;


  {: Clase para almacenar una lista de puntos.}
  TPointList = Class(TCollection)
  private
    function GetPoint(index: integer): TPointInfo;
  public
    procedure AddPoint(pointInfo:TPointInfo); overload;
    procedure AddPoint(ALat, ALon, AEle, ATime: string;
                       ALatF, ALonF:Double); overload;
    property Point[index:integer]:TPointInfo read GetPoint;
  published
    procedure _debug(TS:TStrings);
    procedure _debugCount(TS:TStrings);

  end;

  TTrack = class(TCollectionItem)
  private
    FTrackPoints: TPointList;
    FPaintColor: Integer;
    FPaintWidth: Integer;
    FTrackName: string;
  public
    // constructor de la clase
    constructor Create(Collection: TCollection); override;
    destructor Destroy; override;
    procedure _debug(TS:TStrings);
  published
    property TrackPoints:TPointList read FTrackPoints write FTrackPoints;
    property TrackName:string read FTrackName write FTrackName;
    property PaintWidth:Integer read FPaintWidth write FPaintWidth;
    property PaintColor:Integer read FPaintColor write FPaintColor;
  end;
  {: Clase para encapsular datos de un segmento que forma un track.}
  TTrackList = class (TCollection)
  private
  public
    constructor Create(ItemClass: TCollectionItemClass);
  end;

  {: Clase para encapsular los Waypoints de un Track.}
  TWayPointList = class (TCollection)
  private
  public
    procedure _debug(TS:TStrings);
  end;

  {: Clase para encapsular toda la información de un track.}
  TTrackData = class(TComponent)
  private
    FVersion: string;
    FXsi: string;
    FMaxLon: string;
    FMaxLat: string;
    FCreator: string;
    FHRef: string;
    FTime: string;
    FMinLon: string;
    FMinLat: string;
    FText: string;
    FTrackList: TTrackList;
    FWayPointList: TWaypointList;
  public
    // Limpiar el contenido de la clase
    procedure Clear;
    // constructor de la clase
    constructor Create(AOwner: TComponent); override;
    destructor Destroy();
  published
    // Datos
    property Creator:string read FCreator write FCreator;
    property Version:string read FVersion write FVersion;
    property Xsi:string read FXsi write FXsi;
    property HRef:string read FHRef write FHRef;
    property Text:string read FText write FText;
    property Time:string read FTime write FTime;
    property MinLat:string read FMinLat write FMinLat;
    property MinLon:string read FMinLon write FMinLon;
    property MaxLat:string read FMaxLat write FMaxLat;
    property MaxLon:string read FMaxLon write FMaxLon;

    // Lista de tracks
    property TrackList:TTrackList read FTrackList write FTrackList;
    // Lista de WayPoints
    property WayPointList:TWaypointList read FWayPointList write FWayPointList;
  end;

Código Delphi [-]
function ComponentToStringProc(Component: TComponent): string;
var
  BinStream:TMemoryStream;
  StrStream: TStringStream;
  s: string;
begin
  BinStream := TMemoryStream.Create;
  try
    StrStream := TStringStream.Create(s);
    try
      BinStream.WriteComponent(Component);
      BinStream.Seek(0, soFromBeginning);
      ObjectBinaryToText(BinStream, StrStream);
      StrStream.Seek(0, soFromBeginning);
      Result:= StrStream.DataString;
    finally
      StrStream.Free;
    end;
  finally
    BinStream.Free
  end;
end;

function StringToComponentProc(Value: string): TComponent;
var
  StrStream:TStringStream;
  BinStream: TMemoryStream;
begin
  StrStream := TStringStream.Create(Value);
  try
    BinStream := TMemoryStream.Create;
    try
      ObjectTextToBinary(StrStream, BinStream);
      BinStream.Seek(0, soFromBeginning);
      Result:= BinStream.ReadComponent(nil);
    finally
      BinStream.Free;
    end;
  finally
    StrStream.Free;
  end;
end;

Código Delphi [-]
  // convertir la clase (TTrackData) a texto
  Str := ComponentToStringProc(td1)

Código Delphi [-]
  // Restaurar el contenido a un objeto de la clase TTrackData
  td2 := TTrackData(StringToComponentProc(Str));

Código Delphi [-]
//---------------------------------------------------------------------------------------------------
object TTrackData
  Creator = '-Neftal'#237'- German'
  Version = 'v.1.0'
  HRef = 'http://neftali.clubdelphi.com'
  Text = 'Importaci'#243'n de tracks'
  Time = '01/01/2013 08:00:00'
  TrackList = <
    item
      TrackPoints = <
        item
          Lat = '2.11'
          Lon = '4.23'
          Ele = '120'
        end
        item
          Lat = '2.111'
          Lon = '4.333'
          Ele = '120'
          Time = '01/01/2013 08:00:00'
          LatF = 2.111
          LonF = 4.333
        end
        item
          Lat = '2.234'
          Lon = '4.123'
          Ele = '125'
          Time = '02:01/2013 08:00:05'
          LatF = 2.234
          LonF = 4.123
        end>
      TrackName = 'Track 1 -sendero-'
      PaintWidth = 3
      PaintColor = 255
    end
    item
      TrackPoints = <
        item
          Lat = '2.90'
          Lon = '4.55'
          Ele = '320'
        end
        item
          Lat = '2.333'
          Lon = '4.444'
          Ele = '180'
          Time = '11/01/2013 07:00:00'
          LatF = 2.333
          LonF = 4.444
        end
        item
          Lat = '2.666'
          Lon = '4.666'
          Ele = '185'
          Time = '12:01/2013 07:00:05'
          LatF = 2.666
          LonF = 4.666
        end>
      TrackName = 'Track 2 -pista forestal-'
      PaintWidth = 3
      PaintColor = 32768
    end>
  WayPointList = <
    item
      Lat = '2.12'
      Lon = '4.23'
      Nombre = 'waypoint1'
      Desc = 'Waypoint 1 -Inicio-'
    end
    item
      Lat = '2.65'
      Lon = '4.45'
      Nombre = 'waypoint2'
      Desc = 'Waypoint 2 -Final-'
    end>
end
//---------------------------------------------------------------------------------------------------