Curso B�sico de Programaci�n
en Visual Basic

Soluciones de la entrega Dieciocho.
Fecha: 26/Abr/98

 

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.
Guillermo


 

entrega anterior

Ir al índice principal del Guille