Un proyecto paso a paso -Cuarta entrega

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)