Un Gran Proyecto, Paso a Paso
Sexta Entrega (10/Abr/97)
Entregas anteriores: Primera,
Segunda, Tercera, Cuarta, Quinta
Lo dicho en otras ocasiones, es recomendable que les eches una visual para seguir el
hilo del proyecto.
Bajate las páginas HTML y los gráficos de
las 6 entregas. (gsnotas_htm.zip 76.0 KB)
Bajate los
listados del proyecto. (gsnotas.zip 30.4 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)
Vamos a empezar hoy por el arreglo de algunas cosillas y a
definir un tipo de datos, que posteriormente usaremos en la consulta.
Lo que he cambiado, añadido, está en esta lista:
1.- Arreglar el "bug" de que se quede marcado como terminado cuando acabamos de añadir un registro.
Para esto sólo tienes que añadir lo siguiente en la parte de Actualización, esta es parte del código:
'...
.Enabled = True
'A ver si así se actualiza correctamente
If Val(.Recordset.Terminada) Then
Check1.Value = 1
Else
Check1.Value = 0
End If
.Refresh
2.- Asignar los valores por omisión al pulsar en Nuevo.
En esta ocasión, añade este código al procedimiento cmdActualizar, en la parte de añadir un Nuevo registro:
'...
Data1.Enabled = False
'Asignar la fecha actual
Text1(cFecha) = Format$(Now, "Short Date")
Text1(cFechaInicio) = Text1(cFecha)
Text1(cTerminada) = "0"
YaEstoyAqui = False
'...
3.- Una variable definida (TYPE) para saber con que campos estamos trabajando.
Esta variable, nos permitirá manejar, o al menos saber, los tipos de datos con los que estamos trabajando en un momento dado. También pongo la declaración de una variable que vamos a usar, este código deberás insertarlo en las declaraciones del módulo glbNotas.bas
'Tipo para los fields (campos) de la base de datos.
Type Campo_t
Nombre As String
Tipo As Long
Tamaño As Integer
End Type
Global Campos() As Campo_t 'Para el manejo de los campos
Global sSepFecha As String 'El separador de las fechas
En el procedimiento de carga de la tabla, añede lo siguiente:
'...
'-(10/Abr/97)- Asignamos el tamaño del array de campos
ReDim Campos(j)
i = -1
For Each Fd In Rs.Fields
i = i + 1
'-(10/Abr/97)- Asignamos los datos de los campos
With Campos(i)
.Nombre = Fd.Name
.Tamaño = Fd.Size
.Tipo = Fd.Type
End With
4.- Cambios para "detectar" los caracteres separadores en los campos de fecha.
Y ahora unas cosillas para que al escribir en un campo de
fecha, nos cambie los caracteres ".", "-" y "/" por el
separador que esté definido en el formato corto de la fecha, normalmente "/"
Primero lo "comprobaremos" para que el programa use el que está definido, este
código lo añades en el Form_Load.
(Seguramente habrá alguna forma
directa de obtenerlo, pero yo no la sé)
Dim sTmp As String
sSepFecha = "/"
sTmp = Format$(Now, "Short Date")
If InStr(sTmp, "/") Then
sSepFecha = "/"
ElseIf InStr(sTmp, "-") Then
sSepFecha = "-"
'Si usas algún separador "predefinido" incluyelo aquí
End If
Ahora añade este código, para que al escribir en el TetBox, se compruebe...
Private Sub Text1_KeyPress(Index As Integer, KeyAscii As Integer)
'Comprobar si estamos en un campo de fecha
'Para los campos de fecha
If Campos(Index).Tipo = dbDate Then
Select Case KeyAscii
Case Asc("-"), Asc("."), Asc("/")
KeyAscii = Asc(sSepFecha)
End Select
End If
End Sub
5.- El formulario para realizar las consultas.
¡Ahora si! Al fin el dichoso formulario
de consulta.
Vamos a necesitar de nuevo el gsInput, así que deberás añadirlo al proyecto
(gsInput.frm y gsInput.bas)
El form en el que se muestra la consulta, quedará de la siguiente forma:
Notarás que está cambiado con respecto a lo que te mostré hace un par de entregas.
Vamos a ver cómo queda el form en el que se realizan las consultas. Este es el form gsQBE.frm
Una vez vista las "fotos" de estos dos nuevos
forms, vamos a ver el código.
Primero el del formulario de consulta. Decir que este código está basado en uno que me
creé hace un par de años. Lo he adaptado para usarlo en el proyecto que tenemos entre
manos, pero se puede usar más o menos de forma genérica, siempre que existan estas
variables:
---una variable llamada elForm que haga referencia al form en el que se quiere hacer la
consulta
---un array llamado Campos() del tipo t_Campo, o al menos que contengan los elementos
Tipo, Nombre y Tamaño.
---una variable sTabla con el nombre de la Tabla a consultar.
---una variable sBase con el nombre de la base de datos en la que está esa tabla.
---y por último que la tabla tenga un campo llamado ID
Y por supuesto los forms de mostrar los datos y los genéricos usados en este proyecto.
Sin más dilación, es decir: "menos rollo y más manteca al bollo", pasamos al "dishoso" código:
'---------------------------------------------------------------
'gsQBE Form para realizar las consultas
'
'(c)Guillermo Som, 1994-97
'---------------------------------------------------------------
Option Explicit
Option Compare Text
Dim nOpciones As Integer 'Número de Opciones para
'la búsqueda y mostrar
Dim MaxCampos As Integer
Dim ComparaOr() As String
Dim SumasCampos() As Long
Dim LongCampos() As Integer
Private Sub Command1_Click()
'Preparado el proceso de búsqueda: 1/Dic/94
Dim sBuscar As String
Dim flag As Boolean
Dim i As Integer
Dim j As Integer
Dim k As Integer
Dim sTmp As String
Dim sTmp2 As String
Dim q As Integer
Dim p As Integer
Dim sLogico As String
'Ahora si en Text1(), se escribe | (AltGr+1),
'o [O] se hará una comparación OR
'y si se empieza con [O] se hace un OR con el
'siguiente campo en vez de un AND (25/Nov/95)
On Local Error Resume Next
'---Asignar a sBuscar los campos y valores de la búsqueda.
sBuscar = ""
For i = 0 To nOpciones
k = CboCampos(i).ListIndex
If k >= 1 Then
If cboComparación(i).ListIndex < 0 Then
cboComparación(i).ListIndex = 0
End If
j = cboComparación(i).ListIndex
'Comprobar si tiene |
sTmp = Trim$(Text1(i).Text)
sLogico = "AND "
'Se admite [O] y [O<cualquier_cosa>]
If Left$(sTmp, 2) = "[O" Then
q = InStr(sTmp, "]")
If q = 0 Then q = 2
sLogico = "OR "
sTmp = Mid$(sTmp, q + 1)
End If
'Separar en el mísmo texto con | o [O]
q = InStr(sTmp, "|")
If q = 0 Then
q = InStr(sTmp, "[O")
End If
p = 0
If q Then
ExtraeOpciones sTmp, q
p = q
End If
If p Then
sTmp = ""
For q = 1 To p - 1
'Arreglar esto...
Select Case Campos(k).Tipo
Case dbByte, dbText, dbMemo
sTmp = sTmp & ComparaOr(q) & "*' OR " & Campos(k).Nombre & " " & cboComparación(i).List(j) & " '*"
Case dbDate
sTmp = sTmp & ComparaOr(q) & "') OR " & Campos(k).Nombre & " " & cboComparación(i).List(j) & " Datevalue('"
Case Else
sTmp = sTmp & ComparaOr(q) & " OR " & Campos(k).Nombre & " " & cboComparación(i).List(j) & " "
End Select
Next
sTmp = sTmp & ComparaOr(p)
End If
Select Case Campos(k).Tipo
Case dbByte, dbText, dbMemo
'poner '* ... *' si es Like o Not Like
If InStr(cboComparación(i).List(j), "Like") Then
sBuscar = sBuscar & Campos(k).Nombre & " " & cboComparación(i).List(j) & " '*" & CStr(sTmp) & "*' " & sLogico
Else
'sólo poner '...' por si se quiere una coincidencia exacta
sBuscar = sBuscar & Campos(k).Nombre & " " & cboComparación(i).List(j) & " '" & CStr(sTmp) & "' " & sLogico
End If
Case dbDate 'poner datevalue('...')
sBuscar = sBuscar & " " & Campos(k).Nombre & " " & cboComparación(i).List(j) & " Datevalue('" & sTmp & "') " & sLogico
Case Else 'no poner '* ... *'
sBuscar = sBuscar & Campos(k).Nombre & " " & cboComparación(i).List(j) & " " & sTmp & " " & sLogico
End Select
flag = True
End If
Next
If Not flag Then
Beep
MsgBox "Se debería seleccionar por lo menos un campo." & Chr$(13) & "Si lo que pretendes es cancelar la búsqueda, pulsa en el botón de Cancelar.", 64
Exit Sub
End If
'Quitarle el final
sBuscar = Left$(sBuscar, Len(sBuscar) - 4)
'Guardar la selección en el fichero INI
GuardarQBE
'Procesar los datos de la consulta
ProcesarConsulta sBuscar
End Sub
Private Sub Command2_Click()
Unload Me
End Sub
Private Sub Command3_Click()
'----------------------------------------------
' Consulta directa
'----------------------------------------------
sFFPoner = Trim$(LeerIni(ficIni, "General", "Buscar", ""))
gsPedirUnValor "Consulta directa", "Escribe el CAMPO y la comparación a usar. Ejemplo: Población LIKE '*Nerja*'", "", sFFPoner, "Aceptar"
If iFFAccion <> cFFAc_Cancelar Then
If Len(sFFPoner) Then
GuardarIni ficIni, "General", "Buscar", sFFPoner
ProcesarConsulta sFFPoner
End If
Else
MostrarConsulta!Command1.Caption = ""
End If
End Sub
Private Sub ExtraeOpciones(sTmp As String, q As Integer)
Dim p As Integer
Dim sTmp2 As String
Dim i As Integer
sTmp2 = sTmp
p = 0
Do
q = InStr(sTmp, "|")
If q Then
sTmp = Mid$(sTmp, q + 1)
p = p + 1
Else
'Buscar también [O
q = InStr(sTmp, "[O")
If q Then
i = InStr(sTmp, "]")
If i = 0 Then q = q + 1
sTmp = Mid$(sTmp, q + 1)
p = p + 1
End If
End If
Loop While q
If Len(Trim$(sTmp)) Then
p = p + 1
End If
sTmp = sTmp2
ReDim ComparaOr(p) As String
p = 0
Do
q = InStr(sTmp, "|")
If q Then
p = p + 1
ComparaOr(p) = Left$(sTmp, q - 1)
sTmp = Mid$(sTmp, q + 1)
Else
q = InStr(sTmp, "[O")
If q Then
ComparaOr(p) = Left$(sTmp, q - 1)
i = InStr(sTmp, "]")
If i = 0 Then q = q + 1
sTmp = Mid$(sTmp, q + 1)
p = p + 1
End If
End If
Loop While q
If Len(Trim$(sTmp)) Then
p = p + 1
ComparaOr(p) = sTmp
End If
q = p
End Sub
Private Sub Form_Load()
Dim i As Integer
Dim j As Integer
Dim t As Integer
Dim dBase2
Dim sTmp As String
MaxCampos = UBound(Campos)
Screen.MousePointer = vbHourglass
Top = 0
Left = 0
'MostrarProgress "Asignando la ventana para la consulta a mostrar... " & vbCrLf
'Ahora siempre se usan Combos para seleccionar los campos
'ya que permiten hacer múltiples comparaciones (24/Nov/95)
nOpciones = 11
Height = 1510 + (nOpciones * 430)
'Cargar los nombres de los campos...
With cboComparación(0)
.Clear
.AddItem "Like"
.AddItem "Not Like"
.AddItem "<"
.AddItem ">"
.AddItem "=<"
.AddItem ">="
.AddItem "="
.AddItem "<>"
End With
CboCampos(0).AddItem "Ninguno"
CboMostrar(0).AddItem "No Mostrar"
For i = 0 To MaxCampos
With Campos(i)
CboCampos(0).AddItem .Nombre
CboMostrar(0).AddItem .Nombre
End With
Next
Text1(0).Text = ""
CboCampos(0).Top = cboComparación(0).Top
CboCampos(0).Visible = True
CboMostrar(0).Top = cboComparación(0).Top
CboMostrar(0).Visible = True
For i = 1 To nOpciones
Load cboComparación(i)
Load Text1(i)
Load CboCampos(i)
Load CboMostrar(i)
For j = 0 To cboComparación(0).ListCount - 1
cboComparación(i).AddItem cboComparación(0).List(j)
Next
For j = 0 To CboCampos(0).ListCount - 1
CboCampos(i).AddItem CboCampos(0).List(j)
CboMostrar(i).AddItem CboMostrar(0).List(j)
Next
cboComparación(i).Top = cboComparación(i - 1).Top + cboComparación(i - 1).Height + 75
cboComparación(i).Visible = True
CboCampos(i).Top = cboComparación(i).Top
CboCampos(i).Visible = True
CboMostrar(i).Top = cboComparación(i).Top
CboMostrar(i).Visible = True
Text1(i).Top = cboComparación(i).Top
Text1(i).Visible = True
Text1(i).Text = ""
Next
'Poder recuperar la última consulta...
For i = 0 To nOpciones
sTmp = "OpCampo" & RTrim$(Str$(i))
CboCampos(i).ListIndex = LeerIni(ficIni, "QBE_" & sUsuario, sTmp, 0)
sTmp = "OpComparacion" & RTrim$(Str$(i))
cboComparación(i).ListIndex = LeerIni(ficIni, "QBE_" & sUsuario, sTmp, 0)
sTmp = "OpTexto" & RTrim$(Str$(i))
Text1(i).Text = LeerIni(ficIni, "QBE_" & sUsuario, sTmp, "")
sTmp = "OpMostrar" & RTrim$(Str$(i))
CboMostrar(i).ListIndex = LeerIni(ficIni, "QBE_" & sUsuario, sTmp, 0)
Next
'Poner en orden las tabulaciones...
For i = nOpciones To 0 Step -1
CboCampos(i).TabIndex = 0
Text1(i).TabIndex = 0
cboComparación(i).TabIndex = 0
CboMostrar(i).TabIndex = 0
Next
Command3.TabIndex = 0
Command2.TabIndex = 0
Command1.TabIndex = 0
Command1.Top = ScaleHeight - 510
Command2.Top = Command1.Top
Command3.Top = Command1.Top
Label1(4).Top = Command1.Top + 45
Screen.MousePointer = vbDefault
End Sub
Private Sub GuardarQBE()
Dim i As Integer
Dim sValor As String
Dim sTmp As String
'Guardar la última consulta...
For i = 0 To nOpciones
sTmp = "OpCampo" & RTrim$(Str$(i))
sValor = Str$(CboCampos(i).ListIndex)
GuardarIni ficIni, "QBE_" & sUsuario, sTmp, sValor
sTmp = "OpComparacion" & RTrim$(Str$(i))
sValor = Str$(cboComparación(i).ListIndex)
GuardarIni ficIni, "QBE_" & sUsuario, sTmp, sValor
sTmp = "OpTexto" & RTrim$(Str$(i))
sValor = Text1(i).Text
GuardarIni ficIni, "QBE_" & sUsuario, sTmp, sValor
sTmp = "OpMostrar" & RTrim$(Str$(i))
sValor = Str$(CboMostrar(i).ListIndex)
GuardarIni ficIni, "QBE_" & sUsuario, sTmp, sValor
Next
End Sub
Private Sub Form_Unload(Cancel As Integer)
Set gsQBE = Nothing
End Sub
Private Sub Label1_Click(Index As Integer)
Dim msg As String
If Index = 4 Then
msg = "CONSEJOS PARA USAR LA OPCIÓN DE BÚSQUEDA" & vbCrLf & vbCrLf
msg = msg & "Selecciona los campos de búsqueda, la comparación, "
msg = msg & "el texto a comparar y los campos que quieres mostrar." & vbCrLf
msg = msg & "Por defecto se hace una búsqueda selectiva, es decir deben coincidir "
msg = msg & "todos los campos especificados con la comparación que se hace." & vbCrLf
msg = msg & "Aunque se puede hacer una búsqueda opcional, (no selectiva): "
msg = msg & "no tienen porqué coincidir todos los campos, sino que se puede "
msg = msg & "buscar por conceptos distintos, más abajo hay varios ejemplos." & vbCrLf
msg = msg & "Las comparaciones que se pueden hacer son: " & vbCrLf
msg = msg & " LIKE Igual" & vbCrLf
msg = msg & "NOT LIKE Distinto (no igual)" & vbCrLf
msg = msg & " > Mayor" & vbCrLf
msg = msg & " < Menor" & vbCrLf
msg = msg & " >= Mayor o igual" & vbCrLf
msg = msg & " <= Menor o igual" & vbCrLf
msg = msg & " = Igual" & vbCrLf
msg = msg & " <> Distinto" & vbCrLf
msg = msg & "La diferencia entre 'LIKE'/'NOT LIKE' y '='/'<>' "
msg = msg & "es que con los LIKE se pueden usar los comodines: * ? #" & vbCrLf
msg = msg & "-- ? un caracter cualquiera" & vbCrLf
msg = msg & "-- # un dígito (número)" & vbCrLf
msg = msg & "-- * cualquier cantidad de caracteres" & vbCrLf
msg = msg & "Ejemplos:" & vbCrLf
msg = msg & "-- M* todos los registros que en el campo especificado, empiecen por M" & vbCrLf
msg = msg & "-- *M* que tenga una M" & vbCrLf
msg = msg & "-- A?C cualquier secuencia que empiece con A y termine con C: ABC, AAC, etc." & vbCrLf
msg = msg & vbCrLf & "IMPORTANTE: Por defecto, para los campos de texto, lo que se escriba en la casilla "
msg = msg & "del texto a buscar, se pone entre dos *, de esta forma se buscará "
msg = msg & "cualquier registro que tenga ese texto escrito; por tanto el uso del "
msg = msg & "comodín * no tiene actualmente ningún significado, en el futuro "
msg = msg & "es posible que haya que expecificarlo, pero por ahora no es necesario." & vbCrLf & vbCrLf
msg = msg & "En CONSULTA DIRECTA si se puede especificar este comodín, (más abajo se explica como usar la Consulta Directa)." & vbCrLf & vbCrLf
msg = msg & "En una misma casilla de texto, se pueden especificar varias palabras, "
msg = msg & "separando cada palabra con: " & vbCrLf
msg = msg & "| (AltGr+1) o con [O]" & vbCrLf
msg = msg & "Ejemplo: para buscar la palabra CASA o CHALET, escribiríamos: "
msg = msg & "CASA|CHALET o bien CASA[O]CHALET" & vbCrLf
msg = msg & "Veamos varios ejemplos:" & vbCrLf
msg = msg & "Buscar las fechas iguales a 4/11/95 o 7/11/95" & vbCrLf
msg = msg & " COMPARACIÓN TEXTO" & vbCrLf
msg = msg & " = 04/11/95|07/11/95" & vbCrLf
msg = msg & "Buscar las fechas mayores al 10/11/95" & vbCrLf
msg = msg & " > 10/11/95" & vbCrLf
msg = msg & "Cuidado cuando se especifican varias comparaciones ya "
msg = msg & "que puede que se pidan cosas imposibles:" & vbCrLf
msg = msg & "Si estos dos ejemplos se especifican en la mísma "
msg = msg & "búsqueda, no mostraría nada, ya que se le dice:" & vbCrLf
msg = msg & " Todas las fechas que sean iguales al 4 de nov" & vbCrLf
msg = msg & " 'O' iguales al 7 de nov" & vbCrLf
msg = msg & " 'Y' que sean mayores al 10 de nov" & vbCrLf
msg = msg & "la verdad es que no se cumpliría esa comparación, "
msg = msg & "ya que no puede ser igual al 4 nov y también mayor que el 10 nov." & vbCrLf
msg = msg & "El error está en pensar que se haría de esta forma:" & vbCrLf
msg = msg & " Todas las fechas que sean iguales al 4 de nov" & vbCrLf
msg = msg & " 'O' iguales al 7 de nov" & vbCrLf
msg = msg & " 'Y' LAS que sean mayores al 10 de nov" & vbCrLf & vbCrLf
msg = msg & "Es importante tener en cuenta, como apunté al principio, que siempre que se "
msg = msg & "comparan varios campos (o uno en distintas "
msg = msg & "líneas) se hace un 'Y', es decir que se tienen que "
msg = msg & "cumplir todas las comparaciones, (comparación selectiva)." & vbCrLf
msg = msg & "Para cambiar el 'Y' por un 'O' (comparación opcional), "
msg = msg & "escribir [O] en el campo anterior al que se quiere aplicar." & vbCrLf
msg = msg & "En el ejemplo anterior, escribiríamos en el primer campo:" & vbCrLf
msg = msg & " COMPARACIÓN TEXTO" & vbCrLf
msg = msg & " = [O]04/11/95|07/11/95" & vbCrLf
msg = msg & "en el segundo:" & vbCrLf
msg = msg & " > 10/11/95" & vbCrLf
msg = msg & "Se mostrarían todas las fechas:" & vbCrLf
msg = msg & " iguales al 4 nov" & vbCrLf
msg = msg & " 'O' igual al 7 nov" & vbCrLf
msg = msg & " 'O' mayor al 10 nov" & vbCrLf
msg = msg & "NOTA: Cuando se usan fechas, hay que tener en cuenta el formato usado, es decir si se deben especificar o no los ceros delante de los números. Por regla general, deben especificarse." & vbCrLf
msg = msg & "En caso de textos:" & vbCrLf
msg = msg & "Buscar todos los JUAN 'O' los que viven en NERJA" & vbCrLf
msg = msg & " CAMPO COMPARACIÓN TEXTO" & vbCrLf
msg = msg & " Nombre Like [O]Juan" & vbCrLf
msg = msg & " Población Like Nerja" & vbCrLf & vbCrLf
msg = msg & "COMO USAR LA CONSULTA DIRECTA:" & vbCrLf
msg = msg & "En la consulta directa se debe especificar el o los campos a comparar y la comparación a realizar: " & vbCrLf
msg = msg & "Para eso es necesario saber como se llama el campo que se quiere comparar, "
msg = msg & "la lista de los nombres de los campos sale en la ventana de la opción de configuración, "
msg = msg & "por defecto las etiquetas informativas de la pantalla principal o las listas de los nombres "
msg = msg & "de los campos que aparecen en esta opción de búsqueda, son los nombres de "
msg = msg & "los campos, salvo que se hayan cambiado con la opción de Configuración." & vbCrLf
msg = msg & "En la consulta directa no se permite usar | ni [O]" & vbCrLf
msg = msg & "Ejemplo: Buscar todos los JUAN 'O' los que viven en NERJA" & vbCrLf
msg = msg & "Se hará de esta forma:" & vbCrLf
msg = msg & "Nombre LIKE '*Juan*' OR [Población] LIKE '*Nerja*'" & vbCrLf
msg = msg & "Para buscar todos los registros que en el campo Nombre tengan Juan "
msg = msg & "y la Fecha sea superior al 10/11/95:" & vbCrLf
msg = msg & "Nombre LIKE '*Juan*' OR Fecha > DATEVALUE('10/11/95')" & vbCrLf
msg = msg & "Como se puede ver, la Consulta Directa es más complicada de usar y está "
msg = msg & "sólo para usarla si se sabe lo que se quiere hacer o para especificar otras "
msg = msg & "opciones que no están contempladas en la búsqueda normal." & vbCrLf
msg = msg & "El lenguaje que se usa es SQL (Structured Query Lenguage) "
msg = msg & "y la instrucción que se hace es:" & vbCrLf
msg = msg & "SELECT * FROM " & sTabla & " WHERE <búsqueda> ORDER BY ID" & vbCrLf
msg = msg & "<búsqueda> es el texto que se escribe." & vbCrLf
msg = msg & "Los datos mostrados, serán los que se especifiquen en los campos a mostrar, al igual que en la consulta normal." & vbCrLf & vbCrLf
msg = msg & "IMPORTANTE: En estas rutinas de búsqueda no se hace distinción entre mayúsculas y minúsculas."
msg = msg & vbCrLf & vbCrLf & "[FIN DEL MENSAJE DE AYUDA]"
If MsgConfirm(msg) Then
End If
msg = ""
End If
End Sub
Private Sub ProcesarConsulta(sBuscar As String)
Dim Db As Database
Dim strCampos As String
Dim SQLtmp As String
Dim MySnap As Recordset
Dim i As Integer
Dim flag As Integer
Dim j As Integer
Dim k As Integer
Dim sTmp As String
Dim sTmp2 As String
Dim q As Integer
Dim p As Integer
Dim sLogico As String
Dim iLongCampo As Integer
ReDim LongCampos(MaxCampos)
On Local Error Resume Next
Screen.MousePointer = vbHourglass
'Abrir la base...
Set Db = OpenDatabase(sBase)
'Ejecutar orden SQL con los datos solicitados
SQLtmp = "select * from " & sTabla & " where " & sBuscar & " order by ID"
Set MySnap = Db.OpenRecordset(SQLtmp, dbOpenSnapshot)
MySnap.MoveFirst
If Err Then
Err = 0
'no hay datos, avisar
MsgBox "No hay datos que coincidan con la búsqueda especificada.", 64
cboComparación(0).SetFocus
Screen.MousePointer = vbDefault
Exit Sub
End If
Load MostrarConsulta
MostrarConsulta!List1.Clear
strCampos = ""
'Añadir los nombres de los "campos" a mostrar
For i = 0 To nOpciones
k = CboMostrar(i).ListIndex
If k >= 1 Then
If Campos(k - 1).Tipo = dbLong Then
LongCampos(k - 1) = 12
ElseIf Campos(k - 1).Tipo = dbText Then
LongCampos(k - 1) = Campos(k - 1).Tamaño
If LongCampos(k - 1) > 30 Then
LongCampos(k - 1) = 30
End If
Else
LongCampos(k - 1) = 8
End If
strCampos = strCampos & Left$(Trim$(Campos(k - 1).Nombre) & Space$(LongCampos(k - 1)), LongCampos(k - 1)) & ", "
End If
Next
With MostrarConsulta
.List1.AddItem strCampos
.List1.ItemData(.List1.NewIndex) = -1
.List1.AddItem String$(Len(strCampos), "-")
.List1.ItemData(.List1.NewIndex) = -1
End With
flag = False
MySnap.MoveFirst
Do Until MySnap.EOF
DoEvents
strCampos = ""
For i = 0 To nOpciones
k = CboMostrar(i).ListIndex - 1
If k >= 0 Then
flag = True
iLongCampo = LongCampos(k - 1)
strCampos = strCampos & Left$(Trim$(MySnap(Campos(k - 1).Nombre) & " ") & Space$(iLongCampo), iLongCampo) & ", "
If Err Then
strCampos = strCampos & Left$("¡¡¡ERROR!!!" & Space$(iLongCampo), iLongCampo) & ", "
Err = 0
End If
End If
Next
MostrarConsulta!List1.AddItem strCampos
MostrarConsulta!List1.ItemData(MostrarConsulta!List1.NewIndex) = MySnap("ID")
MySnap.MoveNext
Loop
If Not flag Then
'no hay datos, avisar
MsgBox "No hay datos que coincidan con la búsqueda especificada.", 64
cboComparación(0).SetFocus
Screen.MousePointer = vbDefault
Exit Sub
End If
Screen.MousePointer = vbDefault
Unload Me
End Sub
Ahora le toca el turno al form de mostrar los datos.
'---------------------------------------------------------------
' Para mostrar los datos de la consulta
'
'(c)Guillermo Som, 1994-97
'---------------------------------------------------------------
Option Explicit
Dim EstaImprimiendo As Integer
Dim CancelarImpresion As Integer
Private Sub CmdBuscar_Click()
Hide
gsQBE.Show vbModal
If MostrarConsulta!Command1.Caption = "" Then
Unload MostrarConsulta
Else
MostrarConsulta.Show
End If
End Sub
Private Sub CmdEditar_Click()
Dim registro As Long
If List1.ListIndex < 0 Then 'No ha registro seleccionado
MsgBox "Debes seleccionar de la lista el registro a mostrar.", 48
Else
registro = List1.ItemData(List1.ListIndex)
If registro > 0 Then
With elForm
.Data1.Recordset.FindFirst "ID = " & registro
If .Data1.Recordset.EOF Then
Beep
MsgBox "Ese registro no ha sido hallado " & registro
.Data1.Recordset.MoveFirst
Else
.Show
End If
End With
Unload Me
End If
End If
End Sub
Private Sub CmdImprimir_Click()
Dim nFicSal As Integer
Dim sLPT As String
Dim i As Integer
Dim j As Integer
Dim sTmp As String
Dim sImpresora As String
Dim k As Integer
Dim sngFS As Single
Dim sFN As String
On Local Error GoTo ErrorImprimiendo
If EstaImprimiendo Then
CancelarImpresion = True
Command1.Enabled = True
CmdBuscar.Enabled = True
CmdImprimir.Caption = "Imprimir"
Else
'--- Para leer del Win.ini
'sTmp = GetSetting("win.ini", "windows", "device", "")
'sLPT = "LPT1"
'sImpresora = "Impresora desconocida"
'If Len(sTmp) Then
' i = InStr(sTmp, ",")
' If i Then
' sImpresora = Left$(sTmp, i - 1)
' sTmp = Mid$(sTmp, i + 1)
' 'Quitar el nombre del controlador...
' i = InStr(sTmp, ",")
' If i Then
' sTmp = Mid$(sTmp, i + 1)
' End If
' i = InStr(sTmp, ":")
' If i Then
' sLPT = Left$(sTmp, i - 1)
' End If
' End If
'End If
'---
sImpresora = Printer.DeviceName
sLPT = Printer.Port
If Right$(sLPT, 1) = ":" Then
sLPT = Left$(sLPT, Len(sLPT) - 1)
End If
sTmp = "Para imprimir los datos en:" & Chr$(13) & sImpresora & " en " & sLPT & Chr$(13) & "Pulsa:" & Chr$(13)
sTmp = sTmp & "Si: para usar el controlador de Windows." & Chr$(13)
sTmp = sTmp & "No: para imprimir directamente, en letra pequeña." & Chr$(13)
sTmp = sTmp & "Cancelar: para no imprimir."
'Imprimir los datos...
i = MsgBox(sTmp, 32 + 3, "Imprimir datos")
EstaImprimiendo = True
Command1.Enabled = False
CmdBuscar.Enabled = False
CmdImprimir.Caption = "Cancelar Impresión"
sTmp = Caption
k = List1.ListCount
If i = 6 Then
'Usar controlador de Windows
sngFS = Printer.FontSize
sFN = Printer.FontName
If MsgBox("¿Quieres Imprimir con Courier New 9 puntos?", 4 + 32, "Imprimir") = 6 Then
Printer.FontSize = 9
Printer.FontName = "Courier New"
End If
Printer.Print ""
Printer.Print ""
For i = 0 To k - 1
DoEvents
If CancelarImpresion Then Exit For
Caption = "Imprimiendo " & i + 1 & " de " & k
Printer.Print Left$(List1.List(i), 132)
Next
Printer.EndDoc
Printer.FontSize = sngFS
Printer.FontName = sFN
ElseIf i = 7 Then
'Imprimir directamente...
j = 0
nFicSal = FreeFile
Open sLPT For Output As nFicSal
Print #nFicSal, Chr$(15); 'Letra pequeña
For i = 0 To k - 1
DoEvents
If CancelarImpresion Then Exit For
Caption = "Imprimiendo " & i + 1 & " de " & k
Print #nFicSal, Left$(List1.List(i), 136)
j = j + 1
If j = 50 Then
Print #nFicSal, Chr$(12);
j = 0
End If
Next
If j Then
Print #nFicSal, Chr$(12);
End If
Print #nFicSal, Chr$(18);
Close nFicSal
End If
Caption = sTmp
EstaImprimiendo = False
CancelarImpresion = False
Command1.Enabled = True
CmdBuscar.Enabled = True
CmdImprimir.Caption = "Imprimir"
End If
Exit Sub
ErrorImprimiendo:
MsgBox "Se ha producido el error" & Chr$(13) & Error$(Err) & Chr$(13) & "al intentar imprimir."
Caption = sTmp
EstaImprimiendo = False
CancelarImpresion = False
Command1.Enabled = True
CmdBuscar.Enabled = True
CmdImprimir.Caption = "Imprimir"
Exit Sub
End Sub
Private Sub Command1_Click()
Unload Me
End Sub
Private Sub Form_Activate()
Const LB_SETHORIZONTALEXTENT = &H400 + 21
Const NULO = &O0
Dim ListhWnd
Dim ListLen
Dim iTmp
Dim ScaleTmp As Integer
'Mostrar el número de datos hallados
Caption = "Resultado de la búsqueda: " & List1.ListCount - 4 & " datos"
'Poner un scroll horizontal al ListBox
ScaleTmp = ScaleMode
ListhWnd = List1.hWnd
ScaleMode = 3
ListLen = 4000
iTmp = SendMessage(ListhWnd, LB_SETHORIZONTALEXTENT, ListLen, NULO)
ScaleMode = ScaleTmp
End Sub
Private Sub Form_Load()
'Posicionarla en la parte superior izquierda
Top = 0
Left = 0
End Sub
Private Sub Form_Resize()
If WindowState <> 1 Then
Command1.Top = ScaleHeight - Command1.Height - 120
CmdImprimir.Top = Command1.Top
CmdBuscar.Top = Command1.Top
cmdEditar.Top = Command1.Top
List1.Move 90, 90, ScaleWidth - 180, Command1.Top - 180
End If
End Sub
6.- Para Rematar.
Bueno, creo que ya está la cosa más lograda. Por supuesto hay que añadir al menú archivo la opción de consulta, si no se hace, ¿cómo vas a ejecutarla? La forma de llamar a esta ventana es la siguiente:
Private Sub mnuConsulta_Click()
gsQBE.Show vbModal
If MostrarConsulta!Command1.Caption = "" Then
Unload MostrarConsulta
Else
MostrarConsulta.Show
End If
End Sub
Ya está bien por hoy. Sigue atento a esta pantalla, para ver cuando es la próxima entrega...
Nos vemos. (...pronto espero.)
