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:
- Que la clase sea pública
- Que la clase tenga asignado el valor 1 a la propiedad Persistable
- Que las propiedades que nos interese copiar se almacenen en el objeto PropertyBag, (usando el evento WriteProperties)
- Si tenemos otros objetos incluidos en la clase y nos interesa copiar también esos objetos, estos deben ser también "Persistables"
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)
' 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
'------------------------------------------------------------------------------
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 7
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
On Local Error GoTo ErrGuardar
' 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 App.Path & "\" & 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
On Local Error GoTo ErrLeer
' Instanciación de un objeto PropertyBag.
Set pb = New PropertyBag
' Lee el contenido de un archivo en una variable de tipo Variant.
Open App.Path & "\" & 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)
' 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
'------------------------------------------------------------------------------
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, en este caso se declara como procedimiento Property Get
Public Property Get FechaCreación() As String
End Property
'------------------------------------------------------------------------------
' cPersistable (22/Ago/99)
' 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
'------------------------------------------------------------------------------
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)
' 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
'------------------------------------------------------------------------------
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 de ejemplo, pulsa este link. (copiar_objetos.zip 9.72 KB)
Nerja, 24 de Agosto de 1999
