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:
- 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) ' 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