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)