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