[aprendiz2]

Código Delphi [-]
{---------------------------------------------------------}
{ Delphi 5                                                }
{                                                         }
{ Descripcion del problema:                               }
{ 1)  ObjectBinaryToText reporta problemas al intentar    }
{    convertir un TComponent que contiene otro TComponent }
{    como miembro interno.                                }
{ El programa tiene 2 Botones:
{ TButton1 - Aparentemente funciona bien.. ( estara bien realmente ? ) }
{ TButton2 - Ahi hay problemas... por que ?               }
{---------------------------------------------------------}

unit Unit1;
interface
uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls;
type
  TForm1 = class(TForm)
    Button1: TButton;
    Button2: TButton;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

  {----------------------------------}
  {   TMiembro pasa a ser un miembro }
  {   dentro de TPrincipal           }
  {----------------------------------}
  TMiembro = class( TComponent)
     private
         FAlgo2 : string;
     published
         property Algo2  : string read FAlgo2 write FAlgo2;
  end;
  {------------------------------------------------------}
  {  TPrincipal                                          }
  {                                                      }
  {  Se intenta :                                        }
  {   1) Pasar a un TMemoryStream un objeto de           }
  {      tipo TPrincipal - aparentemente se logra bien   }
  {                                                      }
  {   2) Convertir ese TMemoryStream a representacion en }
  {      texto - con el ObjectBinaryToText -- ahi sale   }
  {      el problema                                     }
  {------------------------------------------------------}
  TPrincipal = class( TComponent )
     private
         FAlgo1  : string;
         FMiembro : TMiembro;
     protected
         procedure DefineProperties( Filer : TFiler ) ; override;
         procedure LeeMiembro( Reader : TReader );
         procedure EscribeMiembro( Writer : TWriter );
     public
         constructor Create( aOwner : TComponent ); override;
         destructor  Destroy; override;
         property    Miembro : TMiembro read FMiembro write FMiembro;
     published
         property Algo1  : string read FAlgo1 write FAlgo1;
     end;
var
  Form1: TForm1;
implementation

{$R *.DFM}
procedure TForm1.Button1Click(Sender: TObject);
  var P1, P2 : TPrincipal ;
      MS     : TMemoryStream;
begin
   {-----------------------------------------------}
   {   Escribir el objeto P1 a un Stream           }
   {   y despues crear P2 a partir de ese stream   }
   {   ( Aparentemente funciona bien   )           }
   {-----------------------------------------------}
   P1 := TPrincipal.Create( nil );
   with P1 do
   begin
       Algo1 := 'JUAN';
       Miembro.Algo2 := 'PEDRO';
   end;
   MS := TMemoryStream.Create;
   MS.WriteComponent( P1 ) ;
   {--------------------------}
   { Crear P2 desde el Stream }
   {--------------------------}
   MS.Position := 0;
   P2 := MS.readComponent( nil ) as TPrincipal ;
   {--------------------------}
   {   Mostrar que hay en P2  }
   {--------------------------}
   ShowMessage( P2.Algo1 + '   ' + P2.Miembro.Algo2 );
   { Aparentemente todo salio bien aqui.... }
   P1.Free;
   P2.Free;
   MS.Free;
end;
{ TPrincipal }
constructor TPrincipal.Create(aOwner: TComponent);
begin
  inherited;
  FMiembro := TMiembro.Create( Self );
end;
procedure TPrincipal.DefineProperties(Filer: TFiler);
begin
  inherited;
 {-----------------------------------------------------------------------------------------}
 { Favor probar el programa "eliminando" la siguiente instruccion -ponerla como comentario }
 {-----------------------------------------------------------------------------------------}
  Filer.DefineProperty( 'Miembro', LeeMiembro, EscribeMiembro, FMiembro <> nil );
end;
destructor TPrincipal.Destroy;
begin
  FMiembro.Free;
  FMiembro := nil;
  inherited;
end;
procedure TPrincipal.EscribeMiembro(Writer: TWriter);
begin
   { En la Ayuda dice "Nunca llamar a Writer.WriteComponent",      }
   { pero no se otra forma de provocar la escritura de FMiembro,   }
   { aparentemente funciona bien con el WriteComponent....         }
   { Claro, se podria hacer FMiembro.writeString( Algo2 ),         }
   { pero esa no es la gracia,                                     }
   { cada objeto deberia escribir lo suyo...                       }
   Writer.writeComponent( FMiembro );
end;
procedure TPrincipal.LeeMiembro(Reader: TReader);
begin
   Reader.ReadComponent( FMiembro );
end;
procedure TForm1.Button2Click(Sender: TObject);
  var P1,P2 : TPrincipal;
      MS : TMemoryStream;
      SS : TStringStream;
begin
     {---------------------------------------------------}
     {   AYUDA !   AYUDA !   AYUDA !                     }
     { Se intenta convertir la representacion            }
     { de un objeto de clase TPrincipal a                }
     { texto con el ObjectBinaryToText,  pero falla      }
     { en la conversion.                                 }
     { Ojo: TPrincipal contienen un miembro.             }
     { los problemas                                     }
     {---------------------------------------------------}
     P1 := TPrincipal.Create( nil );
     P1.Algo1 := 'JUAN';
     P1.FMiembro.Algo2 := 'PEDRO';

     MS := TMemoryStream.Create;
     SS := TStringStream.Create('');
     { Escribimos P1 al MemoryStream MS }
     MS.WriteComponent( P1 );
     MS.Position := 0;
     {--------------------------------------------}
     { Comprobamos el contedido de MS, creando P2 }
     {--------------------------------------------}
     P2 := MS.ReadComponent( nil ) as TPrincipal;

     ShowMessage('Antes del ObjectBinaryToText' + #13 + ' P2 contiene:' + #13+#13+
                 P2.Algo1 + '   ' + P2.FMiembro.FAlgo2 );
     {---------------------------------------------}
     {        Aqui se nota el problema             }
     {---------------------------------------------}
     MS.Position := 0;
     ObjectBinaryToText( MS, SS );  { <------- AQUI SE REVIENTA   }
     ShowMessage('Despues del ObjectBinaryToText... pase bien !');

     SS.Position := 0;
     ShowMessage('Resultado en texto es: ' + #13 + SS.DataString );
     MS.Free;
     SS.Free;
     P1.Free;
     P2.Free;
end;
initialization
   RegisterClasses( [TPrincipal, TMiembro] );
end.