Agenda muy simple en Visual basic utilizando Ficheros de acceso aleatorio o también denominados Random, para almacenar los datos de los contactos de la Agenda.
Una vista del ejemplo:
Para manipular los datos se utiliza una estructura o UDT que tiene las siguientes variables:
Código: Seleccionar todo
' 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 Pasos a seguir para armar el formulario con los controles:
Agregar en un Formulario 6 controles TextBox con los siguiente nombres:
txtNombre
txtApellido
txtTelefono
txtMail
txtNota
txtBuscar
Luego agregar 7 CommandButton con los siguientes nombres:
CmdAnterior : Botón para ir al anterior registro
cmdSiguiente : Botón para ir al siguiente registro
cmdGuardar : Botón para guardar los cambios cuando se seleccionó previamente la opción Nuevo Registro
cmdEliminar: Elimina el registro actual
cmdNuevo : Añade un nuevo reg
cmdBuscar : Para buscar
Cmdsalir : Descarga el Form
Ahora, agregar un control ComboBox llamado Combo1. A este combo, colocarle en la propiedad Style el valor 2 ( DropDownList ) y agregarle los siguientes valores en la propiedad List: Nombre, Apellido, Telefono e Mail en ese orden
Nota: Para agregar datos en la propiedad List desde la ventana de propiedades, debes mantener la tecla Ctrl presionada y presionar la tecla Enter para añadir un nuevo dato o Item.
Por último, agregar un control Label llamado lblStatus que servirá para poder mostrar cuando nos desplazamos por los registros, con los botones anterior y siguiente, el número del registro actual y la cantidad de registros que hay en el archivo. Este Label lo puedes situar en la parte inferior del formulario o donde quieras.
Código: Seleccionar todo
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