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.

El form gsInput

'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.

Form del Resultado de la Consulta

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)


ir al índice