Solución,
long y type
|
Realizamos
programas para la gestión de empresas. Empresas medianas y
pequeñas. Programas de contabilidad, cartera de pedidos
clientes proveedores, facturación control de albaranes,
tesorería cartera de cobros y pagos y estadísticas.
Nuestro
agradecimiento a todos los que por unas causas o por otras
visitan nuestra web. Gestión de empresas PYMES. Curso de
programación de Visual Basic.
|
Vamos a ver las soluciones a los
ejercicios de la entrega dieciocho:
El primero era crear una utilidad para convertir un fichero de un
tipo a otro. Una solución sería esta:
Private Type t_Colega
Nombre As String * 30
Edad As Integer
email As String * 50
End Type
Private Type t_Colega2
Nombre As String * 30
Edad As Integer
email As String * 50
URL As String * 128
End Type
Private Sub cmdConvertir_Click()
Dim unColega As t_Colega, unColega2 As t_Colega2
Dim nFic As Long, nFic2 As Long
Dim numColegas As Long
Dim i As Long
'abrir el fichero original
nFic = FreeFile
Open "colegas.dat" For Random As nFic Len = Len(unColega)
'abrir el fichero de destino
nFic2 = FreeFile
Open "colegas2.dat" For Random As nFic2 Len = Len(unColega2)
numColegas = LOF(nFic) \ Len(unColega)
For i = 1 To numColegas
'leer el registro
Get #nFic, i, unColega
'Asignar los nombres del nuevo tipo
With unColega
unColega2.Nombre = .Nombre
unColega2.Edad = .Edad
unColega2.email = .email
unColega2.URL = ""
End With
'Guardar el nuevo registro
Put #nFic2, i, unColega2
Next
Close nFic2
Close nFic
'Si quieres eliminar el fichero anterior y cambiarle el nombre
'hazlo después de cerrar los ficheros
End Sub
Este es el listado completo del segundo
ejercicio:
'------------------------------------------------------------------
'Ejercicio de la entrega 18 (26/Abr/98)
'
'©Guillermo 'guille' Som, 1998
'------------------------------------------------------------------
Option Explicit
'Tipo para usar en el fichero
Private Type t_Colega
Nombre As String * 30
Edad As Integer
email As String * 50
End Type
'Esta variable se usará para acceder a los datos
Dim m_unColega As t_Colega
'Número de registros del fichero
Dim m_numColegas As Long
'Número del colega actual, usado cuando se edita, etc.
Dim m_elColega As Long
'Esta variable guardará el fichero a usar
Dim m_sFicColegas As String
'Esta se usará como FLAG para saber si hemos cambiado
'el registro actual
Dim m_Modificado As Boolean
Private Sub cmdGuardar_Click()
Dim nFic As Long
'Sólo si el número del colega es el indicado en Text4
'de esta forma sólo se guardará cuando se pulse en
'Nuevo o en Leer
If m_elColega = Val(Text4) Then
nFic = FreeFile
Open m_sFicColegas For Random As nFic Len = Len(m_unColega)
With m_unColega
.Nombre = Text1
.Edad = Val(Text2)
.email = Text3
End With
'Guardar los datos en el disco
Put #nFic, m_elColega, m_unColega
Close nFic
'Ajustar el número de colegas
m_numColegas = CuantosColegas()
m_Modificado = False
'Posicionar el cursor en el número de registro
Text4.SetFocus
End If
End Sub
Private Sub cmdLeer_Click()
Dim nFic As Long
'No se comprueba si se ha modificado el registro actual
'esto habría que tenerlo en cuenta... lo he dejado preparado
'con la variable m_Modificado
'Te dejo que hagas las comparaciones pertinentes...
'...
'Sólo leer si no se está añadiendo uno nuevo
If m_elColega <= m_numColegas Then
m_elColega = Val(Text4)
'Pero que no se lea un valor "no válido"
If m_elColega > 0 And m_elColega <= m_numColegas Then
nFic = FreeFile
Open m_sFicColegas For Random As nFic Len = Len(m_unColega)
'leer ese registro
Get #nFic, m_elColega, m_unColega
'quitarle los espacios "extras", ya que al ser
'de longitud fija, los espacios en blanco también
'se mostrarán en la caja de texto
'Para comprobarlo, quita el Trim$ y verás lo que
'ocurre cuando el nombre tiene menos caracteres...
With m_unColega
Text1 = Trim$(.Nombre)
Text2 = .Edad
Text3 = Trim$(.email)
End With
Close nFic
m_Modificado = False
Text1.SetFocus
Else
'si el número no es válido...
Text4.SetFocus
m_elColega = 0
End If
End If
End Sub
Private Sub cmdNuevo_Click()
'¿Comprobar si se ha modificado?
'...
'Añadir un nuevo colega,
'sólo si no se está introduciendo uno nuevo
If m_elColega <> m_numColegas + 1 Then
m_elColega = m_numColegas + 1
Text4 = m_elColega
'Limpiar el contenido de las cajas de texto
Text1 = ""
Text2 = ""
Text3 = ""
'Limpiar también la variable el registro actual,
'aunque realmente no es necesario...
With m_unColega
.Nombre = ""
.Edad = 0
.email = ""
End With
m_Modificado = False
'Posicionar el cursor en el campo del nombre
Text1.SetFocus
End If
End Sub
Private Sub Form_Load()
'asignamos el path del fichero de colegas:
m_sFicColegas = App.Path & "\Colegas.dat"
'Esta asignación fallará si el path es el directorio raiz
'por tanto se debería comprobar de esta forma:
If Right$(App.Path, 1) = "\" Then
m_sFicColegas = App.Path & "Colegas.dat"
Else
m_sFicColegas = App.Path & "\Colegas.dat"
End If
'También de esta otra forma... algo menos "clara"
m_sFicColegas = App.Path & _
IIf(Right$(App.Path, 1) = "\", "", "\") & _
"Colegas.dat"
'Inicialmente leer el número de registros
'lo pongo en una función para usarlo cuando se necesite,
'sin tener que repetir el proceso, aunque corto, pero...
m_numColegas = CuantosColegas()
'Borrar el contenido de los TextBox
Text1 = ""
Text2 = ""
Text3 = ""
Text4 = ""
'Para empezar no se ha modificado
m_Modificado = False
End Sub
Private Function CuantosColegas() As Long
'Esta función se encarga de informarnos del número de registros
'que tiene el fichero
'Usarlo sólo cuando queremos saber esta información y
'no necesitamos mantener el fichero abierto
'si no existe el fichero, se producirá un error
On Local Error Resume Next
CuantosColegas = FileLen(m_sFicColegas) \ Len(m_unColega)
If Err Then
CuantosColegas = 0
End If
Label1(4) = "Número de colegas:" & CuantosColegas
Err = 0
End Function
Private Sub Form_Unload(Cancel As Integer)
'Por si se quedó o estaba el fichero abierto...
Close
Set Form1 = Nothing
End Sub
Private Sub Text1_Change()
'Si en lugar de usar tres TextBox distintos se usara un array
'sería más cómodo, ya que sólo se pondrá esta asignación
'en un sólo evento Change.
'
m_Modificado = True
End Sub
Private Sub Text2_Change()
m_Modificado = True
End Sub
Private Sub Text3_Change()
m_Modificado = True
End Sub
A ver si la próxima entrega no se
hace de rogar demasiado, que ya estamos casi a punto de acabar con
esto del acceso a los ficheros...
Nos vemos.
