Un Gran Proyecto, Paso a Paso
Cuarta Entrega (3/Abr/97)
Entregas anteriores: Primera,
Segunda, Tercera
Es recomendable
que les eches una visual para seguir el hilo del proyecto.
Bajate las p�ginas HTML y los gr�ficos.
(gsnotas_htm.zip 43.8 KB)
Bajate los
listados del proyecto. (gsnotas.zip 16.2 KB)
(Estos tama�os variar�n seg�n el n�mero de entregas; para saber el tama�o actual,
deber�as ver la �ltima entrega)
Bueno, ya est�n llegando las sugerencias sobre el rumbo
que debe seguir este proyecto, por ahora van ganando los seguidores de que sea en 32 bits.
Pero no te asustes si a�n est�s programando en 16 bits, incluso si usas VB3, porque todo
es compatible hasta el momento.
Si usas VB3/VB2 te recomiendo que veas las recomendaciones
para convertir los listados de VB4-16bits a c�digo usable por VB3 y espero que pronto
cambies a un sistema de 32 bits (incluido el Visual Basic)
Vamos al tajo. Hoy la cosa va de preparar una consulta (query o b�squeda, como prefieras llamarla).
La b�squeda se realizar� en un campo
determinado y nos servir� para ir mostrando en la pantalla de edici�n los datos que
coinciden con los que queremos buscar.
La consulta ya es una tarea m�s "trabajada" y nos permite
buscar en distintos campos, sincronizando los datos que queremos comprobar. Por ejemplo,
queremos mostrar todos los datos que est�n entre dos fechas y que en el campo Asunto
tenga una palabra determinada, etc.
Por tanto la b�squeda es m�s simple. S�lo se comprueba un campo y sin ning�n tipo de
rango.
La consulta puede tener en cuenta un mismo campo con varios valores y/o estar dentro de un
rango. Incluso pondremos opciones que sean "excluyentes" y/o
"incluyentes" (no s� si se
dice as�, pero ahora explico de que van estas "palabrejas")
Es decir que podemos buscar datos en el campo Asunto (por ejemplo), que tengan un valor
determinado y unos datos en el campo Descripci�n; (ahora viene lo de "incluyente y excluyente"), podemos hacer un AND es decir que deben estar los valores en los dos
campos o podemos hacer un OR para que estando cualquiera de los dos valores, nos sirva.
Empecemos entonces por la rutina de b�squeda, para lo cual s�lo necesitamos incluir un bot�n de comandos en nuestra barra de tareas, m�s adelante convertiremos estos CommandButton en una barra de herramientas con gr�ficos y todo eso.
Abre el form gsNotas y a�ade uno nuevo, para ello,
selecciona uno de los que est�n y pulsa en Edici�n/Copiar, pulsa en el Picture de la
barra de tareas y ahora pegalo (pulsa en Edici�n/Pegar).
Cambiale el caption a Buscar... y a�ade la siguiente declaraci�n en las declaraciones
del Form:
Const CMD_BUSCAR = 3
Ahora vamos a escribir el c�digo necesario para realizar
la b�squeda. Para esta tarea tan simple necesitamos una forma de pedir el dato que
queremos buscar, bien usando el InputBox del Visual Basic (descartado por su "simpleza") o bien crearnos un di�logo nosotros mismos, (eso es lo que vamos a hacer).
Para crear el di�logo vamos a usar unas rutinas que ya tengo creadas y un form gen�rico
de di�logo, (s� ese), el que ya puse en Utilidades (gsInput), que lo vuelvo a incluir,
(adaptado y modificado en un par de aspectos, con respecto a lo que ya estaba publicado),
para que veas c�mo se hacen las cosas. 8-)
A�ade al proyecto los siguientes archivos: gsInput.bas y gsInput.frm
En el m�dulo bas se incluyen las declaraciones de las variables, constantes, funciones y
procedimientos a usar.
Veamos una imagen del Form y los listados del m�dulo y el c�digo del form.
La utilidad gsInput, para crear di�logos al estilo del MsgBox e InputBox, pero con iconos programables.
'gsInput.Bas '-------------------------------------------------- 'M�dulo para funci�n de confirmaci�n (26/Jul/96) ' '� Guillermo Som Cerezo, 1996-97 ' 'Revisado: ( 5/Mar/97) 'Nueva versi�n: Simulaci�n de InputBox (22/Mar/97) ' 'Funci�n para "simular" una caja de di�logo... m�s o menos 'Necesita el form gsInput.frm '-------------------------------------------------- Option Explicit Global BotonPulsado As Integer 'Constantes para el tipo Global Const cSi = vbOK Global Const cSiNo = vbYesNo Global Const cSiNoCancelar = vbYesNoCancel Global Const cSiCancelar = vbOKCancel Global Const cSiATodo = 8 'Constantes para el bot�n pulsado Global Const cBotonSi = vbYes '6 Global Const cBotonNo = vbNo '7 Global Const cBotonCancelar = vbCancel '2 Global Const cBotonSiATodo = 8 '8 Private Sub PosicionarControles(sEntrada As String, iTipo As Integer, sCaption As String, Optional vMostrarText) '---------------------------------------------- ' Ajusta los controles a mostrar '---------------------------------------------- Dim i As Integer Dim j As Integer Dim iQueBoton As Integer Dim fHeight As Integer Dim mIzq As Integer 'La posici�n m�s a la izquierda Dim bMostrarText As Boolean If IsMissing(vMostrarText) Then bMostrarText = False Else bMostrarText = CBool(vMostrarText) End If iQueBoton = 0 If iTipo >= 512 Then iQueBoton = 3 iTipo = iTipo Mod 512 ElseIf iTipo >= 256 Then iQueBoton = 2 iTipo = iTipo Mod 256 End If With frmConfirm If bMostrarText Then .Text1.Enabled = True .Text1.Visible = True Else .Text1.Enabled = False .Text1.Visible = False End If If iTipo And vbCritical Then .Image1(0).Picture = .Image1(1).Picture iTipo = iTipo - vbCritical ElseIf iTipo And vbQuestion Then .Image1(0).Picture = .Image1(2).Picture iTipo = iTipo - vbQuestion ElseIf iTipo And vbExclamation Then .Image1(0).Picture = .Image1(3).Picture iTipo = iTipo - vbExclamation ElseIf iTipo And vbInformation Then .Image1(0).Picture = .Image1(4).Picture iTipo = iTipo - vbInformation Else 'Exclamaci�n por defecto .Image1(0).Picture = .Image1(3).Picture End If .Label1(0).Visible = True .Label1(0) = sEntrada fHeight = .Label1(0).Top + .Label1(0).Height + 1040 If .Text1.Enabled Then fHeight = fHeight + 420 End If If fHeight < 2500 Then fHeight = 2500 End If .Height = fHeight If .Text1.Enabled Then .Text1.Top = fHeight - 1220 End If .Command1(0).Top = fHeight - 800 'Usar enabled en lugar de visible, ya que hasta que se haga el show 'no ser�n realmente visibles For i = 1 To 3 .Command1(i).Enabled = False Next .Command1(0).Visible = True 'Seleccionar los botones a mostrar If iTipo = vbYesNo Then .Command1(2).Enabled = True ElseIf iTipo = vbYesNoCancel Then .Command1(2).Enabled = True .Command1(3).Enabled = True ElseIf iTipo = 8 Then .Command1(1).Enabled = True .Command1(2).Enabled = True .Command1(3).Enabled = True ElseIf iTipo = vbOKCancel Then .Command1(3).Enabled = True .Command1(0).Caption = "Aceptar" Else 'Si s�lo se muestra un bot�n... .Command1(0).Caption = "Aceptar" End If 'Ajustar la localizaci�n, seg�n los botones mostrados mIzq = 0 For i = 3 To 0 Step -1 .Command1(i).Top = .Command1(0).Top If .Command1(i).Enabled Then If mIzq = 0 Then mIzq = .ScaleWidth - 1215 Else mIzq = mIzq - 1170 End If .Command1(i).Left = mIzq .Command1(i).Visible = True Else .Command1(i).Visible = False End If Next 'Centrar el form .Move (Screen.Width - .Width) \ 2, (Screen.Height - .Height) \ 2 .Caption = sCaption End With End Sub Public Function InputConfirm(sEntrada As String, sTexto As String, Optional vTipo, Optional vCaption, Optional vPrograma, Optional vIcono) As Integer '---------------------------------------------- ' Muestra la ventana de confirmaci�n '---------------------------------------------- 'Seg�n el valor de iTipo, se mostrar�: ' Si es > de 256, seleccionar No ' Si es => de 512, seleccionar Cancelar ' Aceptar vbOk ' Si, No vbYesNo ' Si, No, Cancelar vbYesNoCancel ' Si, SiATodo, No, Cancelar 8 'Tipo de icono a mostrar: ' Stop vbCritical 16 ' Interrogaci�n vbQuestion 32 ' Exclamaci�n vbExclamation 48 ' Informaci�n vbInformation 64 '---------------------------------------------- 'El valor devuelto ser�: ' Si vbYes ' SiATodo 8 ' No vbNo ' Cancelar vbCancel '---------------------------------------------- Dim i As Integer Dim j As Integer Dim iTipo As Integer Dim sCaption As String Dim sPrograma As String Dim lIcono As Integer If IsMissing(vTipo) Then iTipo = vbOK Else iTipo = vTipo End If If IsMissing(vCaption) Then sCaption = "" Else sCaption = vCaption End If If IsMissing(vPrograma) Then sPrograma = "" Else sPrograma = vPrograma End If If IsMissing(vIcono) Then lIcono = 0& Else lIcono = vIcono End If If Len(sPrograma) = 0 Then frmConfirm!Picture1.Visible = False Else frmConfirm.ExtraerIcono sPrograma, lIcono End If frmConfirm!Text1 = sTexto PosicionarControles sEntrada, iTipo, sCaption, True '========================================================================== 'Nota si falla el .Show vbModal usa �ste c�digo ' 'Do ' frmConfirm.Show ' DoEvents 'Loop Until BotonPulsado ' frmConfirm.Show vbModal '========================================================================== sTexto = frmConfirm.Text1 InputConfirm = BotonPulsado Unload frmConfirm DoEvents End Function Public Function MsgConfirm(sEntrada As String, Optional vTipo, Optional vCaption, Optional vPrograma, Optional vIcono) As Integer '---------------------------------------------- ' Muestra la ventana de confirmaci�n '---------------------------------------------- 'Seg�n el valor de iTipo, se mostrar�: ' Si es > de 256, seleccionar No ' Si es => de 512, seleccionar Cancelar ' Aceptar vbOk ' Si, No vbYesNo ' Si, No, Cancelar vbYesNoCancel ' Si, SiATodo, No, Cancelar 8 'Tipo de icono a mostrar: ' Stop vbCritical 16 ' Interrogaci�n vbQuestion 32 ' Exclamaci�n vbExclamation 48 ' Informaci�n vbInformation 64 '---------------------------------------------- 'El valor devuelto ser�: ' Si vbYes ' SiATodo 8 ' No vbNo ' Cancelar vbCancel '---------------------------------------------- Dim i As Integer Dim j As Integer Dim iTipo As Integer Dim sCaption As String Dim sPrograma As String Dim lIcono As Integer If IsMissing(vTipo) Then iTipo = vbOK Else iTipo = vTipo End If If IsMissing(vCaption) Then sCaption = "" Else sCaption = vCaption End If If IsMissing(vPrograma) Then sPrograma = "" Else sPrograma = vPrograma End If If IsMissing(vIcono) Then lIcono = 0& Else lIcono = vIcono End If If Len(sPrograma) = 0 Then frmConfirm!Picture1.Visible = False Else frmConfirm.ExtraerIcono sPrograma, lIcono End If PosicionarControles sEntrada, iTipo, sCaption '========================================================================== 'Nota si falla el .Show vbModal usa �ste c�digo ' 'Do ' frmConfirm.Show ' DoEvents 'Loop Until BotonPulsado ' frmConfirm.Show vbModal '========================================================================== MsgConfirm = BotonPulsado Unload frmConfirm DoEvents End Function El c�digo de gsInput.frm '-------------------------------------------------- ' gsInput.frm (22/Mar/97) ' '� Guillermo Som Cerezo, 1996-97 ' 'Basado en gsConfirm (26/Jul/96) 'Revisado: ( 5/Mar/97) 'Nueva versi�n: Simulaci�n de InputBox (22/Mar/97) 'Si se hacen las modificiones m�nimas, se puede usar en VB3 (3/Abr/97) ' 'Funci�n para "simular" una caja de di�logo... m�s o menos 'Necesita el m�dulo gsInput.bas '-------------------------------------------------- Option Explicit 'Declaraciones del API #If Win32 Then Private Declare Function GetClassWord Lib "user32" _ (ByVal hWnd As Long, ByVal nIndex As Long) As Long Private Declare Function ExtractIcon Lib "shell32.dll" Alias "ExtractIconA" _ (ByVal hInst As Long, ByVal lpszExeFileName As String, ByVal nIconIndex As Long) As Long Private Declare Function DrawIcon Lib "user32" _ (ByVal hDC As Long, ByVal X As Long, ByVal Y As Long, ByVal hIcon As Long) As Long #Else Private Declare Function GetClassWord Lib "User" _ (ByVal hWnd As Integer, ByVal nIndex As Integer) As Integer Private Declare Function ExtractIcon Lib "shell.dll" _ (ByVal hInst As Integer, ByVal lpszExeFileName As String, ByVal nIconIndex As Integer) As Integer Private Declare Function DrawIcon Lib "User" _ (ByVal hDC As Integer, ByVal X As Integer, ByVal Y As Integer, ByVal hIcon As Integer) As Integer #End If Public Sub ExtraerIcono(sPrograma As String, queIcon As Integer) 'Cargar el icono indicado del programa #If Win32 Then Dim myhInst As Long Dim hIcon As Long Dim i As Long Const GCW_HMODULE = (-16&) Dim miIcon As Long #Else Dim myhInst As Integer Dim hIcon As Integer Dim i As Integer Const GCW_HMODULE = (-16) Dim miIcon As Integer #End If 'necesario para que sea Integer o Long, seg�n sea 16 o 32 bits miIcon = queIcon myhInst = GetClassWord(hWnd, GCW_HMODULE) hIcon = ExtractIcon(myhInst, sPrograma, miIcon) If hIcon Then Picture1.Picture = LoadPicture("") Picture1.AutoRedraw = -1 i = DrawIcon(Picture1.hDC, 0, 0, hIcon) Picture1.Refresh Else Picture1.Visible = False End If End Sub Private Sub Command1_Click(Index As Integer) Select Case Index Case 0 BotonPulsado = vbYes Case 1 BotonPulsado = cSiATodo '8 Case 2 BotonPulsado = vbNo Case Else BotonPulsado = vbCancel End Select Hide End Sub Private Sub Form_Load() ' BotonPulsado = 0 End Sub Private Sub Form_Unload(Cancel As Integer) 'Si se cierra sin pulsar bot�n, es como si se cancelara If BotonPulsado = 0 Then BotonPulsado = vbCancel End If Set frmConfirm = Nothing End Sub
Bueno, esto es con respecto a estas utilidades, para ver la explicaci�n de c�mo usarlo, echale una visual a la explicaci�n que en su d�a puse, o bien sigue el c�digo usado, (no es muy complicado).
Veamos ahora el c�digo que hay que a�adir para realizar
la b�squeda.
(He cambiado la estructura IF...THEN por una SELECT...CASE)
Case CMD_BUSCAR 'Buscar registros 'Si no estamos en un Text de b�squeda, salir If ControlActual = 0 Then Exit Sub Static sBuscar As String Dim sTmp As String Dim i As Integer If InputConfirm("Escribe el dato a buscar", sBuscar, vbOKCancel + vbQuestion, _ "Buscar datos") <> vbCancel Then sBuscar = Trim$(sBuscar) If Len(sBuscar) Then YaEstoyAqui = True Data1.Recordset.FindFirst Text1(ControlActual).DataField & _ " LIKE '" & sBuscar & "*'" If Data1.Recordset.NoMatch Then Beep MsgBox "No se ha hallado el dato buscado en el campo: " & Text1(ControlActual).DataField, vbOK + vbInformation, "Buscar" Text1(ControlActual).SetFocus Else sTmp = sBuscar If Left(sTmp, 1) = "*" Then sTmp = Mid$(sTmp, 2) End If 'Seleccionar el texto hallado With Text1(ControlActual) i = InStr(.Text, sTmp) .SelStart = i - 1 .SelLength = Len(sTmp) 'posicionarse en ese control .SetFocus End With End If YaEstoyAqui = False End If End If
Bien, es simple no?
Si te das cuenta uso la variable ControlActual para saber el control que est�
seleccionado. Esta variable est� declarada en el Form, para que sea accesible a todo el
Formulario. En el evento Text1_GotFocus se le asigna el valor del �ndice:
Private Sub Text1_GotFocus(Index As Integer) 'Esta variable se asignar� cada vez que el control reciba el foco ControlActual = Index End Sub
En este mismo evento del Check1 y el Text2 se asigna a
CERO, para que la rutina de b�squeda no se efect�e. Fijate en la comparaci�n que se
hace: If ControlActual = 0 Then Exit Sub
La variable sBuscar la he declarado STATIC para que conserve el valor, as� al pulsar de
nuevo en Busca, se muestra el �ltimo valor buscado.
Cuando se encuentra el registro, se resalta la palabra, de esta forma "vemos"
r�pidamente d�nde est�.
Pero tiene un peque�o fallo: S�lo encuentra el primer registro y no nos permite seguir buscando, para mostrar los siguientes en los que se cumpla. Esto se soluciona a�adiendo una opci�n BuscarSiguiente, que quedar�a as�:
Case CMD_BuscarSiguiente If Len(sBuscar) = 0 Then 'Si no se ha buscado anteriormente cmdAccion_Click CMD_BUSCAR Else YaEstoyAqui = True Data1.Recordset.FindNext Text1(ControlActual).DataField & " LIKE '" & sBuscar & "*'" If Data1.Recordset.NoMatch Then Beep MsgBox "No se han hallado m�s coincidencias del dato buscado en el campo: " & Text1(ControlActual).DataField, vbOK + vbInformation, "Buscar Siguiente" Text1(ControlActual).SetFocus Else sTmp = sBuscar If Left(sTmp, 1) = "*" Then sTmp = Mid$(sTmp, 2) End If 'Seleccionar el texto hallado With Text1(ControlActual) i = InStr(.Text, sTmp) .SelStart = i - 1 .SelLength = Len(sTmp) 'posicionarse en ese control .SetFocus End With End If YaEstoyAqui = False End If
Se declarar� la constante CMD_BuscarSiguiente y tendremos
que a�adir un bot�n a nuestra barra, para este menester.
Fijate en la comparaci�n que se hace del contenido de sBuscar, si est� vac�a se
pregunta por lo que se debe buscar y si no, se pasa a la acci�n de buscar el siguiente
registro que coincida con lo buscado.
Nota: Si cambias de campo, buscar� el contenido de sBuscar dentro de los
registros de ese campo.
El tema de la b�squeda queda "finalizado". En otra ocasi�n sustituiremos el form gsInput por otro m�s elaborado y almacenaremos las cadenas buscadas para que se pueda seleccionar entre las �ltimas b�squedas.
Antes de pasar al tema de la Consulta, deber�amos hacer un
par de arreglos "sofisticados".
Por ejemplo, si no hay datos anteriores que buscar, deshabilitar el bot�n de Siguiente; (esto ser� para m�s adelante)
Si se ha pulsado en Nuevo, no permitir ninguna otra acci�n excepto la de Guardar.
Para ello hay que hacer estos cambios en el Sub de cmdAccion_Click:
Static esNuevo As Boolean '... Case CMD_NUEVO 'Nuevo registro If Not esNuevo Then YaEstoyAqui = True 'Quitar la "posible" marca del Check Check1.Value = 0 Data1.Recordset.AddNew esNuevo = True 'Deshabilitar los botones, excepto el de guardar For i = CMD_NUEVO To CMD_BuscarSiguiente cmdAccion(i).Enabled = False Next cmdAccion(CMD_ACTUALIZAR).Enabled = True Data1.Enabled = False YaEstoyAqui = False Text1(1).SetFocus End If Case CMD_ACTUALIZAR 'Volver a habilitar los botones y poner la variable a False For i = CMD_NUEVO To CMD_BuscarSiguiente cmdAccion(i).Enabled = True Next esNuevo = False '...
Bueno, ya es
hora del tema de la consulta... y de acostarse.
Lo siento, no ha sido intencionado, pero se me ha ido la cosa un poco de
"varilla" y me he enrollado m�s de la cuenta.
Como aperitivo de lo que hay que hacer, te mostrar� el Form en el que se mostrar�n los
datos, bastante simple, por cierto, ya que s�lo tiene un ListBox y dos botones.
Este form se podr� redimensionar y permitir� editar el registro seleccionado, pero eso ser� en la pr�xima ocasi�n (que prometo ser� muy pronto, intentar� que sea en esta misma noche)