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