VBBD_Ejercicio 15_Agenda

' Codigo para pegar en el formulario de la Agenda2

Option Explicit

'Variables
'##################################################

' Estructura para los datos de los contactos de la agenda
Private Type Contacto
    Nombre As String * 40
    Apellido As String * 50
    Telefono As String * 40
    Mail As String * 70
    Nota As String * 250
End Type

'Variables para utilizar la estructura anterior
Dim Datos As Contacto
Dim DatosTemp As Contacto

'Variables para el archivo de los datos de contacto y temporal
Dim FileFree As Integer
Dim FileTemp As Integer

'Variables para la posición del primer y último registro
Dim RegActual As Long
Dim RegUltimo As Long
' Variable para la posición Temporal del registro
Dim RegActualTemp As Long

Dim Pos As Integer, p As Integer




'######################################################
'Funciones y procedimientos
'######################################################



' Subrutina que guarda los datos en el archivo
'#############################################

Private Sub GuardarDatos()

'Asignamos los datos de la estructura con el contenido de los textBox
With Datos

    .Nombre = txtNombre.Text
    .Apellido = txtApellido
    .Telefono = txtTelefono.Text
    .Nota = txtNota.Text
    .Mail = Trim(txtMail)

End With

'Escribimos los datos en el archivo y en la posición
Put #FileFree, RegActual, Datos
End Sub

' Subrutina que Visualiza los datos en los textBox
'##################################################

Private Sub VisualizarDatos()

'Lee del fichero en el registro posicionado y almacena los datos_ _
en la la variable UDT
Get #FileFree, RegActual, Datos

' Mostramos los datos en las cajas de texto
With Datos
    txtApellido = Trim(.Apellido)
    txtNombre = Trim(.Nombre)
    txtTelefono = Trim(.Telefono)
    txtMail = Trim(.Mail)
    txtNota.Text = Trim(.Nota)
End With

'Mostramos en el control Label la posición del registro actual _
y la cantidad  o Total de registros que hay en el archivo
lblStatus.Caption = "Registro Actual: " & CStr(RegActual) & vbNewLine _
                    & " Total de registros: " & CStr(RegUltimo)

End Sub

'Botón que elimina un registro del archivo
'############################################

Private Sub cmdEliminar_Click()

Pos = RegActual

If MsgBox(" Está seguro de eliminar el contacto ? ", vbYesNo) = vbNo Then

txtNombre.SetFocus

Exit Sub
End If

' Verificamos que el archivo temporal no exista, si existe se elimina
If Dir("Temporal.tmp") = "Temporal.tmp" Then
Kill "Temporal.tmp"
End If

FileTemp = FreeFile
'Abrimos y creamos un nuevo fichero temporal
Open "Temporal.tmp" For Random As FileTemp Len = Len(DatosTemp)

RegActual = 1
RegActualTemp = 1

'Se recorren los registros del archivo

For p = 1 To RegUltimo - 1

    Get #FileFree, RegActual, Datos

    'Este es el registro que se elimina
    If RegActualTemp = Pos Then
        RegActual = RegActual + 1
    End If

    Get #FileFree, RegActual, Datos


    With DatosTemp
        .Apellido = Trim(Datos.Apellido)
        .Nombre = Trim(Datos.Nombre)
        .Telefono = Trim(Datos.Telefono)
        .Mail = Trim(Datos.Mail)
        .Nota = Trim(Datos.Nota)
    End With

    'Escribe en el archivo temporal los datos

    Put #FileTemp, RegActualTemp, DatosTemp

    RegActual = RegActual + 1
    RegActualTemp = RegActualTemp + 1

Next


Close FileFree
'Elimina el archjivo con los datos
Kill "Datos.dat"
Close FileTemp

'Renombra el archivo temporal a datos.dat
Name "Temporal.tmp" As "Datos.dat"


' Mostramo los datos en los textbox
Cargar
RegActual = Pos
VisualizarDatos

End Sub

Private Sub cmdGuardar_Click()
GuardarDatos
End Sub

Private Sub Cmdsalir_Click()
'Guarda los cambios en el archivo antes de salir
GuardarDatos

'cierra el archivo abierto
Close #FileFree
End
End Sub

Private Sub form_load()

'Carga el primer registro del archivo
Cargar
'Selecciona en el combo para la búsqueda de datos
Combo1 = Combo1.List(0)

Cargarcaptions

End Sub
Private Sub Cargar()

FileFree = FreeFile
Open "Datos.dat" For Random As FileFree Len = Len(Datos)

RegActual = 1
' Almacenamos la posición del último registro
RegUltimo = LOF(FileFree) / Len(Datos)

If RegUltimo = 0 Then
RegUltimo = 1
End If

'Cargamos los datos en los Textbox
VisualizarDatos
End Sub

'Botón que agrega un nuevo registro
'#####################################

Private Sub cmdNuevo_click()

RegUltimo = RegUltimo + 1


'Limpia los datos de la estructura para poder agregar un nuevo registro
With Datos
    .Apellido = ""
    .Nombre = ""
    .Telefono = ""
    .Mail = ""
    .Nota = ""

End With

' Graba datos vacios en el nuevo registro hasta que se presione el botón _
Guardar que graba los verdaderos datos
Put #FileFree, RegUltimo, Datos

RegActual = RegUltimo


VisualizarDatos
txtNombre.SetFocus
End Sub


'Botón para posicionar en el siguiente registro
'##############################################


Private Sub cmdSiguiente_click()

If RegActual = RegUltimo Then
    MsgBox " Ultimo registro ", vbInformation
Else
'Incrementa la posición
RegActual = RegActual + 1
'Cargamos los datos en el textbox del siguiente registro
VisualizarDatos
End If
txtNombre.SetFocus
End Sub

'Botón para posicionar en el Anterior registro
'##############################################

Private Sub CmdAnterior_click()

If RegActual = 1 Then
    MsgBox " Primer registro ", vbInformation
Else
    'Decrementamos la variable que mantiene la posición del registro actual
    RegActual = RegActual - 1
    'Mostramos los datos en las cajas de texto
    VisualizarDatos
End If

txtNombre.SetFocus

End Sub

'Botón para Buscar datos
'##############################################

Private Sub cmdBuscar_click()

Dim Encontrado As Boolean, PosReg As Long, tmp As Contacto

If txtBuscar = "" Then txtNombre.SetFocus: Exit Sub

Encontrado = False

'Recorremos desde el primer hasta el último en busca del registro a buscar

For PosReg = 1 To RegUltimo

'Leemos el registro
Get #FileFree, PosReg, tmp

'Si es el dato es igual salimos del bucle
If UCase(txtBuscar) = UCase(Trim(BuscarPor(tmp))) Then
    Encontrado = True
    Exit For
End If

Next

If Encontrado Then

    RegActual = PosReg
    'Cargamos los datos en los text
    VisualizarDatos

Else
    MsgBox "Nombre: " & txtBuscar & " No se ha encontrado el registro"
End If
txtNombre.SetFocus

End Sub

'Función que retorna el valor de la búsqueda
'#############################################

Private Function BuscarPor(t As Contacto)

Select Case Combo1.ListIndex

Case 0: BuscarPor = t.Nombre
Case 1: BuscarPor = t.Apellido
Case 2: BuscarPor = t.Telefono
Case 3: BuscarPor = t.Mail

End Select

End Function

' Establece los captions de los controles Command del formulario

Private Sub Cargarcaptions()
Me.Caption = " Agenda simple utilizando archivos aleatorios "
CmdAnterior.Caption = " Anterior "
cmdSiguiente.Caption = " Siguiente "
cmdGuardar.Caption = " Guardar "
cmdEliminar.Caption = " Eliminar "
cmdNuevo.Caption = " Nuevo "
cmdBuscar.Caption = " Buscar "
Cmdsalir.Caption = " Salir "
End Sub