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)
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)