Curso Básico de Programación
en Visual Basic

 

Entrega Treinta y nueve punto dos: 12/Jul/2001
por Guillermo "guille" Som

Si quieres linkar con las otras entregas, desde el índice lo puedes hacer

 

¿Copiar objetos? Sí, Gracias!

Con Visual Basic 6.0 es posible copiar objetos, incluso guardarlos como ficheros para recuperarlos posteriormente... (y todo en tiempo de ejecución, puntualizo).

Actualizado: 24/Ago/99
Revisado: 12/Jul/2001 como añadido a la entrega 39 del curso básico


Parece imposible, ¿verdad? Pero... ¡es cierto! (que es posible copiar objetos, no que es imposible...)
Aunque tiene sus inconvenientes... si es que se le puede llamar inconveniente a hacer algo que es "habitual" hacerlo con los controles ActiveX.

 

¿Cómo se pueden copiar objetos en Visual Basic?

Hasta ahora, la única forma de copiar objetos es creando un método en la propia clase que devuelva un nuevo objeto con el contenido de las propiedades, (normalmente a ese método se le llama Clone), ni tan siquiera usando lenguajes como C++ se podían hacer copias de objetos...
Pero ahora, con la versión 6.0 (y posteriores) de Visual Basic, las clases públicas tienen una propiedad llamada Persistable la cual puede tomar dos valores, por defecto el valor es 0-NotPersistable, pero si se cambia al valor 1-Persistable, se añaden tres nuevos eventos a la clase: InitProperties, ReadProperties y WriteProperties. Si has creado tus propios controles ActiveX, seguramente habrás usado estos eventos, ya que guardando los valores de las propiedades en el objeto PropertyBag puedes mantener valores en las propiedades diferentes a los predeterminados.

Para que nos entendamos:
Cuando creas un control ActiveX, puedes hacer que los valores asignados a las propiedades sea "recordados" y no se pierdan en el limbo cada vez que abres el formulario en el que está colocado el control.

Imaginate el inconveniente, por no usar otra palabra malsonante, si cada vez que cargas un proyecto previamente guardado, tuvieses que asignar el valor del Caption del formulario...
Pues lo mismo que el formulario "recuerda" los valores asignados a las propiedades en tiempo de diseño, se puede hacer con los controles creados por nosotros, y todo ello gracias al objeto PropertyBag y a los eventos ReadProperties -leer los valores de las propiedades- y WriteProperties -guardar los valores de las propiedades-

¿Cómo sabe Visual Basic que el valor de una propiedad ha cambiado?
No lo sabe, pero, aunque lo supiera, como el valor de una propiedad puede cambiar no sólo en los procedimientos Let o Set, Visual Basic pone a nuestra disposición la instrucción PropertyChanged, de esta forma podemos avisarle que una propiedad ha cambiado y así poder guardar el nuevo valor en el objeto PropertyBag.

De todas formas, todo esto está bien explicado en la ayuda del Visual Basic, así que si quieres saber más sobre la forma de "persistir" los valores de las propiedades... ya sabes...

Ahora vamos a pasar al tema que nos interesa:

Crear nuevas copias de objetos con Visual Basic

Los requisitos necesarios para que un objeto creado por un componente ActiveX sea "duplicable" son:

En el código que sigue, veremos cómo crear nuevas copias de nuestros objetos.
El componente de ejemplo tiene dos clases, una con la propiedad Persistable asignada a 1 y la otra asignada a 0.
Por tanto, de una se podrá hacer copias y de la otra no, al menos usando el método rápido de copiar los objetos semi-automáticamente con el objeto PropertyBag.

En el código de ejemplo se muestran dos formas diferentes para hacer copias de objetos:
En el método Clone de la clase Persistable se usa el objeto PropertyBag, mientras que en la clase NotPersistable se usa lo que hasta ahora hemos tenido que usar para poder hacer copias de un objeto.

En el código del formulario de prueba se muestra el código necesario para hacer copias usando un fichero. De esta forma podemos guardar el contenido de las propiedades en un fichero y posteriormente leerlo para que un nuevo objeto tenga los mismos valores...
Las posibles utilidades de esta técnica la dejo a tu imaginación...

Aquí tienes el código, el cual está lo suficientemente comentado, (al menos eso espero),  como para que sea fácilmente comprensible.

Nota:
Los procedimientos GuardarObjeto y LeerObjeto del formulario, muestran la forma de guardar el contenido de un objeto en un fichero y después poder recuperarlo para crear un nuevo objeto.
(¿esto mismo no lo acabo de repetir un poco más arriba?)

Si quieres más información sobre el tema, consulta:
Persistencia en datos de componentes, en la ayuda de Visual Basic (MSDN Library) y para saber más sobre persistencia en los controles ActiveX: Guardar las propiedades de un control, en Generar un control ActiveX.

 

El código

El código del formulario de prueba y una "captura" del mismo, así como un poco de explicación de los controles:
(este formulario estará en un proyecto que tendrá una referencia al componente que tiene las clases mostradas más abajo)

Cuando pulses en el botón "Copiar NotPersistable usando un fichero", te mostrará un error indicando que no se pueden copiar objetos no persistente, sin embargo, al pulsar en "Copiar NotPersistable", se usa el método Clone de la clase, por tanto si que se podrá copiar.

Por otro lado, al pulsar tanto en "Copiar Persistable" como en "Copiar Persistable usando un fichero", la propiedad "Comentario" no se copiará, ya que el valor de esa propiedad no se guarda en el objeto PropertyBag.

Los botones "Refresh..." harán que se muestren los contenidos de las clases en las cajas de texto.

El Frame superior mostrará la clase original (la Persitable o NotPersistable, según el botón pulsado).
El Frame inferior mostrará el contenido de la copia realizada a la clase.

"Fecha Creación" indicará la fecha y hora de creación de la clase... lo aclaro por si piensas que es la creación de otra cosa... ¡nunca se sabe!

 

 


'------------------------------------------------------------------------------
' tPersistable                                                      (22/Ago/99)
' Revisado para el curso básico                                     (12/Jul/01)
'
' Prueba de copiar objetos usando la propiedad Persitable
' Para más información ver en la MSDN de Visual Basic 6.0:
'   Persistencia en datos de componentes
'
' ©Guillermo 'guille' Som, 1999-2001
'------------------------------------------------------------------------------
Option Explicit

' Declaramos las variables de los objetos de prueba
Private m_Clase1 As cPersistable
Private m_Clase2 As cPersistable

Private m_Clase3 As cNotPersistable
Private m_Clase4 As cNotPersistable

Private Sub cmdAsignar_Click(Index As Integer)
    ' Asignar el contenido de los TextBoxes a las clases

    ' El botón de indice 0 asigna los valores a las clases básicas
    If Index = 0 Then
        With m_Clase1
            .Nombre = Text1(0)
            .email = Text1(1)
            .AñoNacimiento = Text1(2)
            .Comentario = Text1(3)
        End With
        With m_Clase3
            .Nombre = Text1(0)
            .email = Text1(1)
            .AñoNacimiento = Text1(2)
            .Comentario = Text1(3)
        End With
    Else
    ' El índice 1 asigna los valores a las otras clases (las copias)
        With m_Clase2
            .Nombre = Text1(4)
            .email = Text1(5)
            .AñoNacimiento = Text1(6)
            .Comentario = Text1(7)
        End With
        With m_Clase4
            .Nombre = Text1(4)
            .email = Text1(5)
            .AñoNacimiento = Text1(6)
            .Comentario = Text1(7)
        End With
    End If

    cmdAsignar(Index).Enabled = False
End Sub

Private Sub cmdCopiar_Click()
    ' Copiar el objeto "Persistable" del 1 en el 2

    ' Copiarlo usando Clone
    ' ---La copia se hace usando el objeto PropertyBag
    Set m_Clase2 = m_Clase1.Clone
    ' Mostrar el segundo objeto
    ' Para probar que realmente son objetos diferentes:
    ' (si no lo fuesen, mostraría el nombre con la palabra <COPIA>)
    With m_Clase2
        .Nombre = "<COPIA> " & .Nombre
    End With
    cmdRefresh_Click 0
End Sub

Private Sub cmdCopiar2_Click()
    ' Copiar el objeto "NotPersistable" del 1 en el 2

    ' Copiarlo usando Clone
    ' ---La copia se hace manualmente, es decir propiedad a propiedad
    Set m_Clase4 = m_Clase3.Clone
    ' Mostrar el segundo objeto
    ' Para probar que realmente son objetos diferentes:
    ' (si no lo fuesen, mostraría el nombre con la palabra <COPIA>)
    With m_Clase4
        .Nombre = "<COPIA> " & .Nombre
    End With
    cmdRefresh_Click 1
End Sub

Private Sub cmdCopiarF_Click()
    '//////////////////////////////////////////////////////////////////////////
    ' El siguiente código es para copiar objetos usando un fichero intermedio
    '//////////////////////////////////////////////////////////////////////////
    ' Guardar el objeto 1
    If GuardarObjeto(m_Clase1) Then
        ' Si se pudo guardar es que la clase es "persistente",
        ' por tanto, leerlo y asignarlo al objeto2
        If LeerObjeto(m_Clase2) Then
            ' Mostrar el segundo objeto
            With m_Clase2
                .Nombre = "<COPIA> " & .Nombre
            End With
        End If
    End If
    cmdRefresh_Click 0
End Sub

Private Sub cmdCopiarF2_Click()
    '//////////////////////////////////////////////////////////////////////////
    ' El siguiente código es para copiar objetos usando un fichero intermedio
    ' (esto no funcionará, ya que las propiedades no son "persistentes")
    '//////////////////////////////////////////////////////////////////////////
    '
    ' Guardar el objeto 1
    If GuardarObjeto(m_Clase3) Then
        ' Si se pudo guardar es que la clase es "persistente",
        ' por tanto, leerlo y asignarlo al objeto2
        If LeerObjeto(m_Clase4) Then
            ' Mostrar el segundo objeto
            With m_Clase4
                .Nombre = "<COPIA> " & .Nombre
            End With
            cmdRefresh_Click 1
        End If
    End If
End Sub

Private Sub cmdRefresh_Click(Index As Integer)
    ' Mostrar el contenido de las clases en los TextBoxes

    ' Tenemos cuidado de los posibles errores que se produzcan
    On Local Error Resume Next

    ' El índice 0 mostrará los contenidos de las clases Persistentes
    If Index = 0 Then
        With m_Clase1
            Text1(0) = .Nombre
            Text1(1) = .email
            Text1(2) = .AñoNacimiento
            Text1(3) = .Comentario
            Label2(0) = .Copia.Nombre
            lblFecha(0) = .FechaCreación
        End With
        With m_Clase2
            Text1(4) = .Nombre
            Text1(5) = .email
            Text1(6) = .AñoNacimiento
            Text1(7) = .Comentario
            Label2(1) = .Copia.Nombre
            lblFecha(1) = .FechaCreación
        End With
    Else
    ' El índice 1 mostrará los contenidos de las clases No Persistentes
        With m_Clase3
            Text1(0) = .Nombre
            Text1(1) = .email
            Text1(2) = .AñoNacimiento
            Text1(3) = .Comentario
            Label2(0) = .Copia.Nombre
            lblFecha(0) = .FechaCreación
        End With
        With m_Clase4
            Text1(4) = .Nombre
            Text1(5) = .email
            Text1(6) = .AñoNacimiento
            Text1(7) = .Comentario
            ' Esto producirá un error si se copia mediante un fichero
            Label2(1) = .Copia.Nombre
            '
            lblFecha(1) = .FechaCreación
        End With
    End If
    cmdAsignar(0).Enabled = False
    cmdAsignar(1).Enabled = False

    Err = 0
End Sub

Private Sub Form_Load()
    ' Limpiar las cajas de texto
    Dim i As Long

    For i = 0 To Text1.Count - 1
        Text1(i) = ""
    Next
    Label2(0) = ""
    Label2(1) = ""

    ' Crear las clases

    ' Las dos que se pueden copiar:
    Set m_Clase1 = New cPersistable
    ' No es necesario crearla con New
    'Set m_Clase2 = New cPersistable

    ' Las dos que no se podrán copiar:
    Set m_Clase3 = New cNotPersistable
    Set m_Clase4 = New cNotPersistable

    ' Unos valores de ejemplo: ¿quién es este?
    Text1(0) = "Guillermo 'guille'"
    Text1(1) = "[email protected]"
    Text1(2) = 1957
    Text1(3) = "El Guille"

    ' Asignar los valores a la clase
    cmdAsignar_Click 0
    ' Mostrar los valores
    cmdRefresh_Click 0

    ' El objeto de copia debe ser una clase Persistable
    Set m_Clase1.Copia = New cPersistable
    ' Prueba usando un objeto no persistente:
    ' (esto no funcionará, ya que el objeto no es persistente y por tanto
    ' no puede guardarse en el PropertyBag)
    'Set m_Clase1.Copia = New cNotPersistable
    m_Clase1.Copia.Nombre = "Guillermo"

    Set m_Clase3.Copia = New cNotPersistable
    m_Clase3.Copia.Nombre = "Guillermo"
End Sub

Private Sub Form_Unload(Cancel As Integer)
    ' Eliminar los objetos previamente declarados
    Set m_Clase1 = Nothing
    Set m_Clase2 = Nothing
    Set m_Clase3 = Nothing
    Set m_Clase4 = Nothing

    Set fPersistable = Nothing
End Sub

Private Sub Text1_Change(Index As Integer)
    ' Habilitar el botón adecuado si se cambia el contenido de las cajas
    Dim queClase As Long

    queClase = 0
    If Index > 3 Then
        queClase = 1
    End If

    cmdAsignar(queClase).Enabled = True

End Sub

Private Function GuardarObjeto(queClase As IPruebaPersistable, _
                               Optional ByVal sFic As String = "CopiaObjeto" _
                               ) As Boolean
    '---------------------------------------------------------------------------
    ' Guardar el objeto indicado en un fichero de texto              (22/Ago/99)
    '
    ' Se usa el parámetro del tipo IPruebaPersistable ya que esa interface
    ' está implementada en los dos objetos del componente de prueba
    '
    ' Esta función devolverá:
    '    False si se produjo error
    '    True  si todo fue bien
    '---------------------------------------------------------------------------
    Dim varTemp As Variant
    Dim pb As PropertyBag
    Dim sPath As String

    On Error GoTo ErrGuardar
    '
    ' Añadir al path de la aplicación la barra de directorio
    sPath = App.Path
    If Right$(sPath, 1) <> "\" Then
        sPath = sPath & "\"
    End If
    ' Instanciación de un objeto PropertyBag.
    Set pb = New PropertyBag
    ' Guarda el objeto en el PropertyBag mediante WriteProperty.
    pb.WriteProperty sFic, queClase
    ' Asigna el contenido del PropertyBag a un variable de tipo Variant.
    varTemp = pb.Contents
    ' Lo guarda en un archivo de texto.
    Open sPath & sFic & ".txt" For Binary As #1
    Put #1, , varTemp
    Close #1

    GuardarObjeto = True
    Exit Function

ErrGuardar:
    MsgBox "Error al guardar el objeto en el fichero:" & vbCrLf & _
            sFic & vbCrLf & Err.Number & " - " & Err.Description

    Err = 0
    GuardarObjeto = False
End Function

Private Function LeerObjeto(queClase As IPruebaPersistable, _
                            Optional ByVal sFic As String = "CopiaObjeto" _
                            ) As Boolean
    '---------------------------------------------------------------------------
    ' Leer el objeto del fichero y asignarlo a la clase indicada     (22/Ago/99)
    '
    ' Se usa el parámetro del tipo IPruebaPersistable ya que esa interface
    ' está implementada en los dos objetos del componente de prueba
    '
    ' Esta función devolverá:
    '    False si se produjo error
    '    True  si todo fue bien
    '---------------------------------------------------------------------------
    Dim varTemp As Variant
    Dim byteArr() As Byte
    Dim pb As PropertyBag
    Dim sPath As String

    On Error GoTo ErrLeer
    ' Añadir al path de la aplicación la barra de directorio
    sPath = App.Path
    If Right$(sPath, 1) <> "\" Then
        sPath = sPath & "\"
    End If
    ' Instanciación de un objeto PropertyBag.
    Set pb = New PropertyBag
    ' Lee el contenido de un archivo en una variable de tipo Variant.
    Open sPath & sFic & ".txt" For Binary As #1
    Get #1, , varTemp
    Close #1
    ' Asigna el valor de la variable Variant a una matriz de bytes.
    byteArr = varTemp
    ' Asigna el valor a la propiedad Contents del objeto PropertyBag
    pb.Contents = byteArr
    ' Instancia el objeto desde el objeto PropertyBag
    Set queClase = pb.ReadProperty(sFic)

    LeerObjeto = True
    Exit Function
ErrLeer:
    MsgBox "Error al leer el objeto del fichero:" & vbCrLf & _
            sFic & vbCrLf & Err.Number & " - " & Err.Description

    Err = 0
    LeerObjeto = False
End Function

 

El código de las clases:
(todas son clases públicas y están incluidas en un componente ActiveX DLL)


'------------------------------------------------------------------------------
' IPruebaPersistable                                                (22/Ago/99)
' Revisado para el curso básico                                     (12/Jul/01)
'
' Interface para usar en el componente PruebaPersistable
' (esta clase no tiene porqué ser Persistable y aunque lo sea no servirá de nada,
' es decir: la clase NotPersistable seguirá sin poder copiarse)
'
' ©Guillermo 'guille' Som, 1999-2001
'------------------------------------------------------------------------------
Option Explicit

' Aunque estas propiedades están declaradas como "variables" públicas,
' al usar Implements se crearán dos procedimientos: Get y Let
' (Get y Set en caso del objeto Copia)
Public Copia As IPruebaPersistable
Public Nombre As String
Public AñoNacimiento As Long
Public email As String
Public Comentario As String

' Propiedad de sólo lectura
Public Property Get FechaCreación() As String

End Property

 


'------------------------------------------------------------------------------
' cPersistable                                                      (22/Ago/99)
' Revisado para el curso básico                                     (12/Jul/01)
'
' Componente para hacer copias de objetos usando la propiedad Persitable
'
' Para poder usar esto de la "persistencia" de las propiedades hay que
' asignar a la propiedad Persistable de la clase el valor 1-Persistable
'
' ©Guillermo 'guille' Som, 1999-2001
'------------------------------------------------------------------------------
Option Explicit

' Clase genérica para usar tanto con esta clase como con la otra no persistente
' De esta forma se tiene una misma clase para poder acceder a los métodos y
' propiedades de cualquier clase que la implemente,
' por ejemplo, el método Copia devuelve un objeto de este tipo
Implements IPruebaPersistable

' Valor por defecto del año de nacimiento
Private Const cAñoNacimiento As Long = 1999

' Variables privadas para contener los valores de las propiedades
Private m_FechaCreación As String

Private m_Copia As IPruebaPersistable

Private m_Nombre As String
Private m_AñoNacimiento As Long
Private m_email As String
' Esta propiedad no es persistente, es decir no se guarda en el PropertyBag
Private m_Comentario As String

Public Property Get AñoNacimiento() As Long
    ' Se devuelve el valor contenido en la variable privada
    AñoNacimiento = m_AñoNacimiento
End Property

Public Property Let AñoNacimiento(ByVal NewValue As Long)
    ' Se asigna el nuevo valor en la variable privada
    m_AñoNacimiento = NewValue
    ' y se avisa al Visual Basic de que esta propiedad ha cambiado
    PropertyChanged "AñoNacimiento"
End Property

Public Property Get Comentario() As String
    Comentario = m_Comentario
End Property

Public Property Let Comentario(ByVal NewValue As String)
    ' Como esta propiedad no la hemos hecho "persistente",
    ' no se llama a PropertyChanged
    m_Comentario = NewValue
End Property

Public Property Get Copia() As IPruebaPersistable
    ' Como lo que se devuelve es un objeto,
    ' hay que hacerlo usando Set
    Set Copia = m_Copia
End Property

Public Property Set Copia(ByVal NewValue As IPruebaPersistable)
    ' Esta propiedad devuelve un objeto, por tanto se implementa
    ' como Set en lugar de Let
    Set m_Copia = NewValue
    PropertyChanged "Copia"
End Property

Public Property Get email() As String
    email = m_email
End Property

Public Property Let email(ByVal NewValue As String)
    m_email = NewValue
    PropertyChanged "email"
End Property

' Propiedad de sólo lectura
' por eso sólo está el procedimiento Get
Public Property Get FechaCreación() As String
    FechaCreación = m_FechaCreación
End Property

Public Property Get Nombre() As String
    Nombre = m_Nombre
End Property

Public Property Let Nombre(ByVal NewValue As String)
    m_Nombre = NewValue
    PropertyChanged "Nombre"
End Property

' Este procedimiento se ejecuta cada vez que se crea una instancia de la clase
Private Sub Class_Initialize()
    m_AñoNacimiento = cAñoNacimiento
    'Debug.Print "cPersistable_Initialize"
    ' Esto haría que se quedara sin espacio en la pila,
    ' ya que al crear una nueva instancia haría que se creara otra dentro de esa
    ' y así sucesivamente
    'Set m_Copia = New cPersistable
End Sub

Private Sub Class_InitProperties()
    ' En los controles ActiveX, este procedimiento sólo se ejecuta una vez:
    ' cuando se inserta el control en el contenedor;
    ' pero en las clases, se ejecuta cada vez que se crea la clase.

    ' Asignamos la fecha y hora actual a la variable privada
    m_FechaCreación = Format$(Now, "dd/mmm/yyyy hh:mm:ss")
    ' indicamos que la propiedad ha cambiado,
    ' (sólo se avisará aquí, ya que esta propiedad es de sólo lectura)
    PropertyChanged "FechaCreación"
End Sub

Private Sub Class_ReadProperties(PropBag As PropertyBag)
    ' Este procedimiento se ejecuta cada vez que se leen los valores
    ' guardados en el objeto PropertyBag

    ' Por si se produce algún error
    On Local Error Resume Next

    ' Asignamos los valores almacenados a las variables privadas
    m_Nombre = PropBag.ReadProperty("Nombre")
    m_AñoNacimiento = PropBag.ReadProperty("AñoNacimiento", cAñoNacimiento)
    m_email = PropBag.ReadProperty("email")

    ' Para que la propiedad Comentario sea persistente, quitar el comentario
    'm_Comentario = PropBag.ReadProperty("Comentario")

    m_FechaCreación = PropBag.ReadProperty("FechaCreación")

    '
    Set m_Copia = PropBag.ReadProperty("Copia", Nothing)

    Err = 0
End Sub

Private Sub Class_Terminate()
    'Set m_Copia = Nothing
'    Debug.Print "cPersistable_Terminate"
End Sub

Private Sub Class_WriteProperties(PropBag As PropertyBag)
    ' Este evento se ejecuta cada vez que se guardan los valores en el objeto
    ' PropertyBag

    On Local Error Resume Next

    PropBag.WriteProperty "Nombre", m_Nombre
    PropBag.WriteProperty "email", m_email
    PropBag.WriteProperty "AñoNacimiento", m_AñoNacimiento, cAñoNacimiento

    ' Si no se guarda la propiedad Comentario, no se podrá "clonar"
    'PropBag.WriteProperty "Comentario", m_Comentario

    PropBag.WriteProperty "FechaCreación", m_FechaCreación

    ' Para que el objeto se pueda guardar, debe ser Persistable
    PropBag.WriteProperty "Copia", m_Copia, Nothing

    Err = 0
End Sub

' Los procedimientos implementados delegan en las propiedades de la clase
' Se podrían asignar las variables privadas, pero entonces habría que
' "avisar" de los cambios llamando a PropertyChanged, además de que si en
' los procedimientos se hacen algunas comprobaciones, pues...
' por tanto es mejor llamar a los propios métodos de la clase.
'
Private Property Let IPruebaPersistable_AñoNacimiento(ByVal RHS As Long)
    Me.AñoNacimiento = RHS
End Property

Private Property Get IPruebaPersistable_AñoNacimiento() As Long
    IPruebaPersistable_AñoNacimiento = Me.AñoNacimiento
End Property

Private Property Let IPruebaPersistable_Comentario(ByVal RHS As String)
    Me.Comentario = RHS
End Property

Private Property Get IPruebaPersistable_Comentario() As String
    IPruebaPersistable_Comentario = Me.Comentario
End Property

Private Property Set IPruebaPersistable_Copia(ByVal RHS As IPruebaPersistable)
    Set Me.Copia = RHS
End Property

Private Property Get IPruebaPersistable_Copia() As IPruebaPersistable
    Set IPruebaPersistable_Copia = Me.Copia
End Property

Private Property Let IPruebaPersistable_email(ByVal RHS As String)
    Me.email = RHS
End Property

Private Property Get IPruebaPersistable_email() As String
    IPruebaPersistable_email = Me.email
End Property

Private Property Get IPruebaPersistable_FechaCreación() As String
    IPruebaPersistable_FechaCreación = m_FechaCreación
End Property

Private Property Let IPruebaPersistable_Nombre(ByVal RHS As String)
    Me.Nombre = RHS
End Property

Private Property Get IPruebaPersistable_Nombre() As String
    IPruebaPersistable_Nombre = Me.Nombre
End Property

Public Function Clone() As cPersistable
    ' Devuelve una copia de esta clase                              (23/Ago/99)
    ' Se usa la técnica descrita en la ayuda de Visual Basic 6.0
    ' para copiar objetos usando ficheros de texto,
    ' aunque en este caso no sea necesario ningún fichero intermedio...
    '
    ' Nota:
    '   Anteriormente había usado una NUEVA variable intermedia,
    '   pero no es necesario, incluso si la variable a la que se asigna con Clone
    '   no se ha creado con NEW
    '
    Dim pb As PropertyBag

    ' Instanciación de un objeto PropertyBag.
    Set pb = New PropertyBag

    ' Guarda el objeto en el PropertyBag mediante WriteProperty.
    pb.WriteProperty "CopiaObjeto", Me

    ' Instancia el objeto desde el objeto PropertyBag
    Set Clone = pb.ReadProperty("CopiaObjeto")
End Function

 


'------------------------------------------------------------------------------
' cNotPersistable                                                   (22/Ago/99)
' Revisado para el curso básico                                     (12/Jul/01)
'
' Esta clase tiene asignado el valor 0 a la propiedad Persistable,
' por tanto de esta clase no se podrá hacer copias
'
' Para poder usar esto de la "persistencia" de las propiedades hay que
' asignar a la propiedad Persistable de la clase el valor 1-Persistable
' (ver la clase cPersistable)
'
' ©Guillermo 'guille' Som, 1999-2001
'------------------------------------------------------------------------------
Option Explicit

Implements IPruebaPersistable

Private m_FechaCreación As String

Private m_Copia As IPruebaPersistable

Private m_Nombre As String
Private m_AñoNacimiento As Long
Private m_email As String
Private m_Comentario As String

Private Sub Class_Initialize()
    'Set m_Copia = New IPruebaPersistable
    m_FechaCreación = Format$(Now, "dd/mmm/yyyy hh:mm:ss")
End Sub

Private Sub Class_Terminate()
    'Set m_Copia = Nothing
End Sub

' Los procedimientos implementados delegan en las propiedades de la clase
'
Private Property Let IPruebaPersistable_AñoNacimiento(ByVal RHS As Long)
    Me.AñoNacimiento = RHS
End Property

Private Property Get IPruebaPersistable_AñoNacimiento() As Long
    IPruebaPersistable_AñoNacimiento = Me.AñoNacimiento
End Property

Private Property Let IPruebaPersistable_Comentario(ByVal RHS As String)
    Me.Comentario = RHS
End Property

Private Property Get IPruebaPersistable_Comentario() As String
    IPruebaPersistable_Comentario = Me.Comentario
End Property

Private Property Set IPruebaPersistable_Copia(ByVal RHS As IPruebaPersistable)
    Set Me.Copia = RHS
End Property

Private Property Get IPruebaPersistable_Copia() As IPruebaPersistable
    Set IPruebaPersistable_Copia = Me.Copia
End Property

Private Property Let IPruebaPersistable_email(ByVal RHS As String)
    Me.email = RHS
End Property

Private Property Get IPruebaPersistable_email() As String
    IPruebaPersistable_email = Me.email
End Property

Private Property Get IPruebaPersistable_FechaCreación() As String
    IPruebaPersistable_FechaCreación = m_FechaCreación
End Property

Private Property Let IPruebaPersistable_Nombre(ByVal RHS As String)
    Me.Nombre = RHS
End Property

Private Property Get IPruebaPersistable_Nombre() As String
    IPruebaPersistable_Nombre = Me.Nombre
End Property

Public Property Get AñoNacimiento() As Long
    AñoNacimiento = m_AñoNacimiento
End Property

Public Property Let AñoNacimiento(ByVal NewValue As Long)
    m_AñoNacimiento = NewValue
End Property

Public Property Get Comentario() As String
    Comentario = m_Comentario
End Property

Public Property Let Comentario(ByVal NewValue As String)
    m_Comentario = NewValue
End Property

Public Property Get Copia() As IPruebaPersistable
    Set Copia = m_Copia
End Property

Public Property Set Copia(ByVal NewValue As IPruebaPersistable)
    Set m_Copia = NewValue
End Property

Public Property Get email() As String
    email = m_email
End Property

Public Property Let email(ByVal NewValue As String)
    m_email = NewValue
End Property

' Propiedad de sólo lectura
Public Property Get FechaCreación() As String
    FechaCreación = m_FechaCreación
End Property

Public Property Get Nombre() As String
    Nombre = m_Nombre
End Property

Public Property Let Nombre(ByVal NewValue As String)
    m_Nombre = NewValue
End Property

Public Function Clone() As cNotPersistable
    ' Devuelve una copia de esta clase                              (23/Ago/99)
    Dim NewClase As cNotPersistable
    Dim NewCopia As IPruebaPersistable

    Set NewClase = New cNotPersistable
    Set NewCopia = New IPruebaPersistable

    ' Esto haría que se quedara sin espacio en la pila
    'Set NewCopia = Me.Clone
    ' Así funcionaría bien
    With NewCopia
        .Nombre = Me.Copia.Nombre
        .AñoNacimiento = Me.Copia.AñoNacimiento
        .Comentario = Me.Copia.Comentario
        .email = Me.Copia.email
        ' ¿¿¿Cómo se copiaría el objeto???
        ' El objeto debería tener un método Clone para copiarlo.
        '.Copia = Me.Copia
    End With
    ' Asignar cada una de las propiedades a la nueva copia.
    ' La desventaja es que, si se tienen muchas propiedades...
    ' pues es más trabajo y puede que por despiste se olvide algo...
    With NewClase
        .Nombre = m_Nombre
        .AñoNacimiento = m_AñoNacimiento
        .email = m_email
        .Comentario = m_Comentario
        Set .Copia = NewCopia
    End With
    ' Si se devuelve este mismo objeto,
    ' no se creará una nueva instancia de la clase
    'Set Clone = Me

    Set Clone = NewClase
End Function

 

Si quieres bajar el código completo del ejemplo, pulsa este link. (copiar_objetos.zip 10.1 KB)

Nerja, 24 de Agosto de 1999
Revisado el 12/Jul/2001 para el curso básico

 


 

ir al índice