Un Gran Proyecto, Paso a Paso
Segunda Entrega (1/Mar/97)
Pulsa aquí,
para ver la Primera Entrega
Nota:
Deberías verla, porque ha habido cambios
Antes de ver el código del formulario de
Entrada, necesitamos crear un módulo para las declaraciones
globales. Inserta un nuevo módulo y guardalo como:glbNotas.bas
Ahora mismo sólo necesitamos unas variables globales: el nombre
del archivo de configuración, el nombre del usuario y la base de
datos, posteriormente incluiremos más cosas.
Añade las siguientes líneas:
'-------------------------------------------------------------- 'glbNotas Módulo para las declaraciones globales (28/Feb/97) '-------------------------------------------------------------- Option Explicit Global ficIni As String 'Archivo de configuración Global sUsuario As String 'Nombre del usuario actual Global sBase As String 'Nombre de la base
La razón de crear el archivo de configuración como global, es que si quieres cambiar el nombre de este archivo, sólo tendrás que modificar una asignación.
Ahora si podemos ver el código del form de Entrada.
Private Sub Form_Load() Dim numBases As Integer Dim sBase As String Dim sNum As String Dim i As Integer 'Archivo de configuración en el directorio de la aplicación ficIni = App.Path & "\gsNotas.ini" Combo1.Text = "" 'Nombre del último usuario Text1 = LeerIni(ficIni, "General", "Usuario", "") 'Leer el número de bases creadas numBases = Val(LeerIni(ficIni, "General", "NumeroBases")) 'Comprobar y leer los nombres For i = 1 To numBases 'Si queremos usar más de 99 nombres, añade un cero más sNum = "Base" & Format$(i, "00") sBase = Trim$(LeerIni(ficIni, "General", sNum)) If Len(sBase) Then 'Añadir al combo, si no es una cadena vacía Combo1.AddItem sBase End If Next 'Si hay datos en el Combo, seleccionar el primero If Combo1.ListCount Then Combo1.ListIndex = 0 End If End Sub Private Sub cmdAceptar_Click() Dim sPath As String 'path de la base especificada Dim sUserPath As String 'path del usuario Dim sUserBase As String 'nombre de la base del usuario Const cMsg = "Seleccionar la base" 'Constante para los MsgBox Dim numBases As Integer 'Número de bases Dim sTmp As String 'varios usos Dim i As Integer 'variable del bucle 'Comprobar si hay datos introducidos sUsuario = Trim$(Text1) If Len(sUsuario) = 0 Then MsgBox "Debes especificar el nombre del usuario.", vbInformation, cMsg 'Posicionarse en el Text1 Text1.SetFocus Exit Sub End If sTmp = Trim$(Combo1.Text) If Len(sTmp) = 0 Then MsgBox "No hay ninguna base de datos seleccionada.", vbInformation, cMsg Combo1.SetFocus Exit Sub End If 'Separar los datos del path y nombre del archivo SplitPath sTmp, sPath, sBase 'Comprobar si la base existe en el combo ' Si no existe, añadirla al combo i = ActualizarLista(sBase, Combo1) If i = -1 Then 'Este caso seguramente nunca se dará, pero... MsgBox "Se ha producido un error inesperado al añadir al combo", vbCritical, cMsg Unload Me End End If 'Esta base, hay que buscarla en las del usuario especificado 'el formato será usuarioXX=path_de_la_base sTmp = sUsuario & Format$(i + 1, "00") sUserPath = Trim$(LeerIni(ficIni, "General", sTmp, sPath)) sUserBase = sUserPath & "\" & sBase 'Por si la ruta es errónea On Local Error Resume Next 'Comprobar si existe "fisicamente" la base If Len(Dir$(sUserBase)) = 0 Then 'No existe, preguntar si se crea If MsgBox("La base especificada no existe." & vbCrLf & "'" & sUserBase & "'" & vbCrLf & "¿Quieres crearla?", vbQuestion + vbYesNo, cMsg) = vbYes Then 'Crear la base CrearBase sUserBase Else Combo1.SetFocus Exit Sub End If End If If Err Then MsgBox "Seguramente la ruta especificada, es errónea:" & vbCrLf & "'" & sUserBase & "'", vbInformation, cMsg Combo1.SetFocus Exit Sub End If 'Guardar los datos de configuración GuardarIni ficIni, "General", sTmp, sUserPath GuardarIni ficIni, "General", "Usuario", sUsuario numBases = Combo1.ListCount GuardarIni ficIni, "General", "NumeroBases", CStr(numBases) 'Guardar los nombres For i = 1 To numBases sTmp = "Base" & Format$(i, "00") sBase = Combo1.List(i - 1) GuardarIni ficIni, "General", sTmp, sBase Next 'Asignar el nombre de la base a la variable global sBase = sUserBase gsNotas.Show 'Descargar este form Unload Me End Sub
Antes de ver el resto, hagamos un alto en
el camino.
Entre otras cosas, porque en el código del botón Aceptar hay
tres rutinas que debemos revisar.
La primera es la función ActualizarLista. Ésta función la
vamos a declarar Global, ya que su uso nos será de utilidad en
el Form principal o en otro, ya veremos.
Así pues, la incluiremos en el módulo global. Abre éste
módulo y añade la siguiente declaración en la sección de las
Declaraciones: (fijate que lParam está declarada com Any en lugar
de Long)
'Funciones Globales del API #If Win32 Then Declare Function SendMessage Lib "User32" Alias "SendMessageA" _ (ByVal hWnd As Long, ByVal wMsg As Long, _ ByVal wParam As Long, lParam As Any) As Long #Else Declare Function SendMessage Lib "User" _ (ByVal hWnd As Integer, ByVal wMsg As Integer, _ ByVal wParam As Integer, lParam As Any) As Long #End If
Esto también lo debes incluir en el módulo global:
Public Function ActualizarLista(sTexto As String, cList As Control) As Long 'Esta función comprobará si el texto indicado existe en la lista 'Si no es así, lo añadirá 'El valor devuelto, será la posición dentro de la lista ó -1 si hay "fallos" ' 'Para buscar en el List/combo usaremos una llamada al API '(si ya hay una forma de hacerlo, ¿para que re-hacerla?) ' Const CB_FINDSTRINGEXACT = &H158 'Mensaje para los combos Const LB_FINDSTRINGEXACT = &H1A2 'Mensaje para las Listas Dim L As Long If cList.ListCount = 0 Then 'Seguro que no está, así que añadirla L = -1 Else 'Si el control es un Combo If TypeOf cList Is ComboBox Then L = SendMessage(cList.hWnd, CB_FINDSTRINGEXACT, -1, ByVal sTexto) 'Si el control es un list ElseIf TypeOf cList Is ListBox Then L = SendMessage(cList.hWnd, LB_FINDSTRINGEXACT, -1, ByVal sTexto) Else 'no es un control List o Combo, salir ActualizarLista = -1 Exit Function End If End If 'Si no está, añadirla If L = -1 Then L = cList.ListCount cList.AddItem sTexto End If ActualizarLista = L End Function
Bien, veamos que es lo que nos encontramos
aquí.
Esta función hará lo siguiente:
Buscará en la lista de items de un ListBox o ComboBox, la cadena
especificada y si no existe, la añadirá, devolviendo
posteriormente la posición dentro de la lista.
Realmente cuando se añade un nuevo dato, devuelve la posición
del último item.
Esto puede ser un problema si la lista está ordenada.
Para solventarlo, después de añadir el dato, efectúa otra
búsqueda llamando recursivamente a la función!
'Si no está, añadirla If L = -1 Then 'L = cList.ListCount cList.AddItem sTexto L = ActualizarLista(sTexto, cList) End If
En el código final del programa, he
incluido ésta última versión.
Fijate que hay dos llamadas a la función SendMessage, una si es
un ListBox y otra si es un ComboBox. Además de efectuar una
búsqueda "total", es decir que la cadena buscada debe
existir completa, aunque el formato de mayúsculas/minúsculas no
se tenga en cuenta.
Para buscar sólo una parte, desde el principio, usa las
constantes:
Const LB_FINDSTRING = &H18F 'Para el listbox Const CB_FINDSTRING = &H14C 'Para el combobox
La segunda rutina que te comentaba es:
SplitPath y se encarga de "dividir" o seccionar una
cadena en la ruta, el nombre del archivo y la extensión, estas
dos últimas cosas las he puestos como opcionales, (he dejado el
nombre en inglés, porque creo que se entenderá perfectamente el
cometido que tiene)
Veamos el código, que debe estar en el módulo global:
Public Sub SplitPath(ByVal sTodo As String, sPath As String, Optional vNombre, Optional vExt) '---------------------------------------------------------------- 'Divide el nombre recibido en la ruta, nombre y extensión '(c)Guillermo Som, 1997 ( 1/Mar/97) ' 'Esta rutina aceptará los siguientes parámetros: 'sTodo Valor de entrada con la ruta completa 'Devolverá la información en: 'sPath Ruta completa, incluida la unidad 'vNombre Nombre del archivo incluida la extensión 'vExt Extensión del archivo ' 'Los parámetros opcionales sólo se usarán si se han especificado '---------------------------------------------------------------- Dim bNombre As Boolean 'Flag para saber si hay que devolver el nombre Dim i As Integer If Not IsMissing(vNombre) Then bNombre = True vNombre = sTodo End If If Not IsMissing(vExt) Then vExt = "" i = InStr(sTodo, ".") If i Then vExt = Mid$(sTodo, i + 1) End If End If sPath = "" 'Asignar el path For i = Len(sTodo) To 1 Step -1 If Mid$(sTodo, i, 1) = "\" Then sPath = Left$(sTodo, i - 1) 'Si hay que devolver el nombre If bNombre Then vNombre = Mid$(sTodo, i + 1) End If Exit For End If Next End Sub
Un poco de aclaración: Esta rutina recibe una cadena con el nombre completo de la ruta y el archivo y devolverá la ruta y opcionalmente el nombre, (con la extensión incluida), y, (también opcionalmente), la extensión.
La tercera rutina es la que se encargará de crear la base de datos, pero la vamos a dejar para otra ocasión, ya que merece más atención. En principio, sólo tienes que dejar la declaración, para que puedas probar lo que estamos haciendo.
Private Sub CrearBase(sBase As String) 'Crear la base de datos indicada ' '===POR HACER=== ' End Sub
Y para poder probarlo, debes especificar el form Entrada como punto de "entrada", valga la redundancia, del programa. Para ello, en el menú Tools, selecciona la opción Options... y en la lengüeta Project selecciona en Startup Form ése formulario.
Para terminar, vamos a ver el resto del
código del formulario de Entrada.
En primer lugar ¿que es lo que hay que hacer cuando un form se
cierra?
'Código del Formulario Entrada Private Sub Form_Unload(Cancel As Integer) 'Liberar memoria Set frmEntrada = Nothing End Sub
Ahora veamos el código del botón Examinar...
Private Sub cmdExaminar_Click() 'Abrir el control de diálogos comunes y "localizar" 'los archivos con extensión MDB 'Seleccionar el fichero en el que se empezará la Busqueda On Local Error Resume Next CommonDialog1.DialogTitle = "Seleccionar Base de Datos" CommonDialog1.Filter = "Bases (*.mdb)|*.mdb|Todos los archivos (*.*)|*.*" CommonDialog1.FilterIndex = 1 CommonDialog1.CancelError = True CommonDialog1.ShowOpen If Err Then Err = 0 Else Combo1.Text = CommonDialog1.filename End If End Sub
Y por último el botón Cancelar:
Private Sub cmdCancelar_Click() 'Terminar el programa!!! Unload Me End End Sub
Bueno, esto es todo por ahora. (Si quieres experimentar,
fijate que no se hace ninguna comprobación de que la extensión
sea correcta en el cmdAceptar)
Mañana más.
Pulsa aquí si quieres bajar los listados de ejemplo
y los archivos HTML
(gsnotas.zip 21.4 KB)
(Este tamaño variará, según el número de entregas; para saber
el tamaño actual, deberías ver la última entrega)