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: Formatted: Font: (Default) Verdana, 10 pt, Font color: Dark Teal
Para manipular los datos se utiliza una estructura o UDT que tiene las siguientes variables: Texto planoImprimir 1. ' Estructura para los datos de los contactos de la agenda 2. Private Type Contacto 3. Nombre As String * 40 4. Apellido As String * 50 5. Telefono As String * 40 6. Mail As String * 70 7. Nota As String * 250 8. End Type
Como se puede ver en la imagen, tiene una opción para buscar un registro y especificar por que campo buscar, ya sea por el nombre del contacto, el Apellido, el telefono o el correo electrónico.
Pasos a seguir para armar el formulario con los controles:
Agregar en un Formulario 6 controles TextBox con los siguiente nombres: 1. 2. 3. 4. 5. 6.
txtNombre txtApellido txtTelefono txtMail txtNota txtBuscar
Luego agregar 7 CommandButton con los siguientes nombres: 1. CmdAnterior : Botón para ir al anterior registro 2. cmdSiguiente : Botón para ir al siguiente registro 3. cmdGuardar : Botón para guardar los cambios cuando se seleccionó previamente la opción Nuevo Registro 4. cmdEliminar: Elimina el registro actual 5. cmdNuevo : Añade un nuevo reg 6. cmdBuscar : Para buscar 7. Cmdsalir : Descarga el Form
Ahora, agregar un control ComboBox llamado Combo1. A este combo, establecerle 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.
Colocar el código fuente en el formulario: Texto planoImprimir 1. Option Explicit 2. 3. 'Variables 4. '################################################## 5. 6. ' Estructura para los datos de los contactos de la agenda 7. Private Type Contacto 8. Nombre As String * 40 9. Apellido As String * 50 10. Telefono As String * 40 11. Mail As String * 70 12. Nota As String * 250 13. End Type 14. 15. 'Variables para utilizar la estructura anterior 16. Dim Datos As Contacto 17. Dim DatosTemp As Contacto 18. 19. 'Variables para el archivo de los datos de contacto y temporal 20. Dim FileFree As Integer 21. Dim FileTemp As Integer 22. 23. 'Variables para la posición del primer y último registro 24. Dim RegActual As Long 25. Dim RegUltimo As Long 26. ' Variable para la posición Temporal del registro 27. Dim RegActualTemp As Long 28. 29. Dim Pos As Integer, p As Integer 30. 31. 32. 33. 34. '###################################################### 35. 'Funciones y procedimientos 36. '###################################################### 37. 38. 39. 40. ' Subrutina que guarda los datos en el archivo 41. '############################################# 42. 43. Private Sub GuardarDatos() 44. 45. 'Asignamos los datos de la estructura con el contenido de los textBox 46. With Datos 47. 48. .Nombre = txtNombre.Text 49. .Apellido = txtApellido 50. .Telefono = txtTelefono.Text 51. .Nota = txtNota.Text 52. .Mail = Trim(txtMail) 53. 54. End With 55. 56. 'Escribimos los datos en el archivo y en la posición 57. Put #FileFree, RegActual, Datos 58. End Sub 59. 60. ' Subrutina que Visualiza los datos en los textBox 61. '##################################################
62. 63. Private Sub VisualizarDatos() 64. 65. 'Lee del fichero en el registro posicionado y almacena los datos_ _ 66. en la la variable UDT 67. Get #FileFree, RegActual, Datos 68. 69. ' Mostramos los datos en las cajas de texto 70. With Datos 71. txtApellido = Trim(.Apellido) 72. txtNombre = Trim(.Nombre) 73. txtTelefono = Trim(.Telefono) 74. txtMail = Trim(.Mail) 75. txtNota.Text = Trim(.Nota) 76. End With 77. 78. 'Mostramos en el control Label la posición del registro actual _ 79. y la cantidad o Total de registros que hay en el archivo 80. lblStatus.Caption = "Registro Actual: " & CStr(RegActual) & vbNewLine _ 81. & " Total de registros: " & CStr(RegUltimo) 82. 83. End Sub 84. 85. 'Botón que elimina un registro del archivo 86. '############################################ 87. 88. Private Sub cmdEliminar_Click() 89. 90. Pos = RegActual 91. 92. If MsgBox(" Está seguro de eliminar el contacto ? ", vbYesNo) = vbNo The n 93. 94. txtNombre.SetFocus 95. 96. Exit Sub 97. End If 98. 99. ' Verificamos que el archivo temporal no exista, si existe se elimina 100. If Dir("Temporal.tmp") = "Temporal.tmp" Then 101. Kill "Temporal.tmp" 102. End If 103. 104. FileTemp = FreeFile 105. 'Abrimos y creamos un nuevo fichero temporal 106. Open "Temporal.tmp" For Random As FileTemp Len = Len(DatosTemp) 107. 108. RegActual = 1 109. RegActualTemp = 1 110. 111. 'Se recorren los registros del archivo 112. 113. For p = 1 To RegUltimo - 1 114. 115. Get #FileFree, RegActual, Datos 116. 117. 'Este es el registro que se elimina 118. If RegActualTemp = Pos Then 119. RegActual = RegActual + 1 120. End If 121. 122. Get #FileFree, RegActual, Datos 123. 124. 125. With DatosTemp
126. 127. 128. 129. 130. 131. 132. 133. 134. 135. 136. 137. 138. 139. 140. 141. 142. 143. 144. 145. 146. 147. 148. 149. 150. 151. 152. 153. 154. 155. 156. 157. 158. 159. 160. 161. 162. 163. 164. 165. 166. 167. 168. 169. 170. 171. 172. 173. 174. 175. 176. 177. 178. 179. 180. 181. 182. 183. 184. 185. 186. 187. 188. 189. 190. 191.
.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
192. RegUltimo = 1 193. End If 194. 195. 'Cargamos los datos en los Textbox 196. VisualizarDatos 197. End Sub 198. 199. 'Botón que agrega un nuevo registro 200. '##################################### 201. 202. Private Sub cmdNuevo_click() 203. 204. RegUltimo = RegUltimo + 1 205. 206. 207. 'Limpia los datos de la estructura para poder agregar un nuevo re gistro 208. With Datos 209. .Apellido = "" 210. .Nombre = "" 211. .Telefono = "" 212. .Mail = "" 213. .Nota = "" 214. 215. End With 216. 217. ' Graba datos vacios en el nuevo registro hasta que se presione e l botón _ 218. Guardar que graba los verdaderos datos 219. Put #FileFree, RegUltimo, Datos 220. 221. RegActual = RegUltimo 222. 223. 224. VisualizarDatos 225. txtNombre.SetFocus 226. End Sub 227. 228. 229. 'Botón para posicionar en el siguiente registro 230. '############################################## 231. 232. 233. Private Sub cmdSiguiente_click() 234. 235. If RegActual = RegUltimo Then 236. MsgBox " Ultimo registro ", vbInformation 237. Else 238. 'Incrementa la posición 239. RegActual = RegActual + 1 240. 'Cargamos los datos en el textbox del siguiente registro 241. VisualizarDatos 242. End If 243. txtNombre.SetFocus 244. End Sub 245. 246. 'Botón para posicionar en el Anterior registro 247. '############################################## 248. 249. Private Sub CmdAnterior_click() 250. 251. If RegActual = 1 Then 252. MsgBox " Primer registro ", vbInformation 253. Else 254. 'Decrementamos la variable que mantiene la posición del regis tro actual
255. 256. 257. 258. 259. 260. 261. 262. 263. 264. 265. 266. 267. 268. 269. 270. 271. 272. 273. 274. 275.
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
276. 277. 278. 279. 280. 281. 282. 283. 284. 285. 286. 287. 288. 289. 290. 291. 292. 293. 294. 295. 296. 297. stro" 298. 299. 300. 301. 302. 303. 304. 305. 306. 307. 308. 309. 310. 311. 312. 313. 314. 315. 316. 317. 318.
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 regi 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 Case Case Case
0: 1: 2: 3:
BuscarPor BuscarPor BuscarPor BuscarPor
End Select End Function
= = = =
t.Nombre t.Apellido t.Telefono t.Mail
319.
' Establece los captions de los controles Command del formulario
320. 321. 322. 323. 324. 325. 326. 327. 328. 329. 330.
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
