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)