Un Gran Proyecto, Paso a Paso
Quinta Entrega (7/Abr/97)
Entregas anteriores: Primera,
Segunda, Tercera, Cuarta
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 5 primeras entregas. (gsnotas_htm.zip 55.2 KB)
Bajate los
listados del proyecto. (gsnotas.zip 20.9 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)
Hoy no voy a abordar todavía el tema de las consultas, lo
siento. Ese será el tema de la próxima entrega.
No es que quiera ponerme "intrigante", pero es que en ese apartado se van a
tener que hecer una serie de "replanteamientos" del programa y habrá que
añadir algunas estructuras de datos y eso voy a dejarlo después de los pequeños cambios
que hoy tengo pensado. A estas alturas sabrás que no tengo este "cursillo"
planeado ni planificado, va saliendo poco a poco y como no soy una persona de ideas fijas,
pues me permito "cambiar" de parecer y espero que no sea a costa de tu
aburrimiento.
Ah!, por cierto, en cuanto a la gente que
"apuesta" por que sea un proyecto de 16 bits, decirte que aún no hay NI UNA.
Espero que esto siga así, la verdad es que no me hace mucha ilusión tener que hacer el
planteamiento para los 16 bits, no sería bueno, creo. Sé que aún hay gente que
"tiene" que trabajar con Win 3.x, pero ya va siendo hora de que cambien...
De todas formas, si hubiese alguna persona interesada en convertirlo a VB3, me podría
tomar la molestia de hacer una versión "paralela", aunque eso sí, con menos
"actualizaciones". (el plazo termina el próximo Miércoles dia 9 de Abril)
Una vez hecha estas aclaraciones, vamos al tema que nos
interesa. Hoy tengo pensado estas cosas:
(Antes de pasar a estos puntos, debemos
hacer unos cambios al form gsNotas)
Los cambios a realizar en el form gsNotas, son los
siguientes:
---Al Picture1, cambiale el Nombre para que se llame ToolBar
---Añadir un pictureBox y asignarle las siguientes propiedades:
Name = StatusBar (hay que ir preparándose para los 32 bits!)
Height = 270
Align = 2-Align Botton
BorderStile = 0-None
---Añadir un Label dentro del Picture que acabas de insertar y asigna las siguientes
propiedades:
Name = LblStatus
BorderStile = 0-None
Ahora añade el siguiente código:
En las declaraciones, después del Option Explicit, deberás poner esto otro, para que la
rutina de búsqueda "no falle"
Option Compare Text
De esta forma, al comparar cadenas (incluso con el Instr),
no se tendrán en cuenta las mayúsculas/minúsculas.
Estas declaraciones, también en la parte general del form, para "recordar" el
tamaño inicial de la ventana, después se usará cuando cambiemos el tamaño.
Dim iH As Integer 'Tamaño mínimo de la ventana Dim iW As Integer
Ahora si, estas son las cosillas para hoy:
1.- Añadir unos menús.
Los vamos a necesitar, ya que se añadirán más opciones
de las que en principio van a "coger" en la barra de herramientas.
Para ello, muestra el form gsNotas. Pulsa en Tools/Menu Editor...
Añade los siguientes "menús"
&Archivo mnuArc --&Nuevo mnuNuevo --G&uardar mnuGuardar --&Borrar mnuBorrar -- - mnuArcSep1 --&Salir mnuSalir &Edición mnuEd --C&ortar mnuCortar Shortcut = ^X --&Copiar mnuCopiar Shortcut = ^C --&Pegar mnuPegar Shortcut = ^V -- - mnuEdSep1 --S&eleccionar Todo mnuSelecTodo Shortcut = ^E -- - mnuEdSep2 --&Buscar... mnuBuscar Shortcut = ^B --Buscar Si&guiente mnuBuscSig Shortcut = {F3} --&Reemplazar mnuReemplazar Shortcut = ^R
Ya tenemos unos cuantos menús creados, ahora vamos a asignarles los comandos a realizar. El tema de la Edición (cortar, copiar, etc., lo dejaremos para otra ocasión)
Añade la siguiente declaración en la parte general del Form:
Const CMD_Reemplazar = 5
Y este es el código para los menús que ahora estan operativos: (fijate que la opción de Reemplazar, se efectuará en el interior del procedimiento del cmdAccion, aunque ese botón no exista, el VB sólo procesa la orden que le digamos y no comprueba si el valor Index recibido en el procedimiento está dentro del rango de botones creados)
Private Sub mnuBorrar_Click() cmdAccion_Click CMD_BORRAR End Sub Private Sub mnuBuscar_Click() cmdAccion_Click CMD_BUSCAR End Sub Private Sub mnuBuscSig_Click() cmdAccion_Click CMD_BuscarSiguiente End Sub Private Sub mnuGuardar_Click() cmdAccion_Click CMD_ACTUALIZAR End Sub Private Sub mnuNuevo_Click() cmdAccion_Click CMD_NUEVO End Sub Private Sub mnuReemplazar_Click() cmdAccion_Click CMD_Reemplazar End Sub Private Sub mnuSalir_Click() cmdSalir_Click End Sub
2.- Ajustar los controles al redimensionar la ventana
Para ajustar el tamaño de los controles, usaremos el
procedimiento Form_Resize. En esta rutina, se comprueba de que no se haga ningún cambio,
si está minimizada y que no se pueda hacer el form más pequeño del tamaño inicial.
Veamos el código: (el Form_Load también se ha modificado)
Private Sub Form_Load() 'El tamaño por defecto iH = Height iW = Width 'El archivo de configuración sFFIni = ficIni Show DoEvents 'Cargar la tabla CargarTabla End Sub Private Sub Form_Resize() Dim i As Integer 'No hacer nada si se minimiza If WindowState = vbMinimized Then Exit Sub 'No permitir un tamaño menor que el inicial If Width < iW Then Width = iW Exit Sub End If If Height < iH Then Height = iH Exit Sub End If Data1.Width = ScaleWidth - 180 Text2.Left = ScaleWidth - Text2.Width - 90 Label1(0).Left = Text2.Left - 450 'Los textBox de Asunto y descripción For i = 2 To 3 With Text1(i) .Width = ScaleWidth - .Left - 90 End With Next 'Los texts y labels del final For i = 4 To 5 With Text1(i) .Top = ScaleHeight - 750 Label1(i).Top = .Top + 30 End With Next Check1.Top = Label1(4).Top 'El alto del text de la descripción With Text1(3) .Height = Text1(4).Top - .Top - 75 End With 'Move es más rápido que efectuar los 3 cambios LblStatus.Move 60, 30, ScaleWidth - 120 End Sub
3.- Nuevo Form para Buscar/Reemplazar
Para la tarea de Reemplazar, vamos a necesitar otro form,
el cual nos va a servir tanto para pedir los datos a Reemplazar como para la rutina de
Buscar, con lo cual no necesitaremos, al menos por ahora, el módulo y el form gsInput,
así que puedes "quitarlos" del proyecto y añadir los siguientes:
gsDBR.Frm y gsDBR.Bas
Esta es una "foto" del form gsDBR
El código de estos dos nuevos módulos es el siguiente:
'---------------------------------------------------- 'Form genérico para diálogo Buscar/Reemplazar ' '©Guillermo Som Cerezo, 1996-97 '---------------------------------------------------- Option Explicit Const NumeroMaximoDeItems = 100 Dim bBuscandoEnCombo As Boolean Private Sub cmdCancel_Click() ActualizarCombo iFFAccion = cFFAc_Cancelar Unload Me End Sub Private Sub cmdFindNext_Click() ActualizarCombo sFFBuscar = txtFind.Text sFFPoner = "" iFFAccion = cFFAc_BuscarSiguiente Unload Me End Sub Private Sub cmdReplace_Click() ActualizarCombo sFFBuscar = txtFind.Text sFFPoner = txtReplace.Text If Len(sFFPoner) = 0 Then iFFAccion = cFFAc_Buscar Else iFFAccion = cFFAc_Reemplazar End If Unload Me End Sub Private Sub cmdReplaceAll_Click() ActualizarCombo sFFBuscar = txtFind.Text sFFPoner = txtReplace.Text If Len(sFFPoner) = 0 Then iFFAccion = cFFAc_Buscar Else iFFAccion = cFFAc_ReemplazarTodo End If Unload Me End Sub Private Sub Combo1_Change(Index As Integer) If bBuscandoEnCombo Then Exit Sub If Index = 0 Then txtFind = Combo1(0).Text Else txtReplace = Combo1(1).Text End If End Sub Private Sub Combo1_Click(Index As Integer) If bBuscandoEnCombo Then Exit Sub If Combo1(Index).ListIndex Then Combo1(Index).Text = Combo1(Index).List(Combo1(Index).ListIndex) End If If Index = 0 Then txtFind = Combo1(Index).Text Else txtReplace = Combo1(Index).Text End If End Sub Private Sub Form_Load() Dim j As Integer Dim i As Integer Dim n As Integer Dim vTmp As String Dim sTmp As String Dim sTag As String If sFFIni = "" Then sFFIni = "BuscReemp.ini" End If 'Posicionar en el centro de la ventana principal Move (Screen.Width - Width) \ 2, (Screen.Height - Height) \ 2 'asignar los valores anteriores del combo For i = 0 To 1 sTag = Trim$(Combo1(i).Tag) n = 0 n = LeerIni(sFFIni, sTag, "NumEntradas", n) If n > NumeroMaximoDeItems Then n = NumeroMaximoDeItems 'For j = n - 1 To 0 Step -1 For j = 0 To n - 1 vTmp = "Entrada" & CStr(j) sTmp = LeerIni(sFFIni, sTag, vTmp, "") If Len(sTmp) Then Combo1(i).AddItem sTmp End If Next Next Combo1(0).Text = "" Combo1(1).Text = "" End Sub Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer) 'Si se cierra por el controlbox, o cualquier forma distinta del propio código, 'asumir que se ha cancelado. If UnloadMode <> vbFormCode Then iFFAccion = cFFAc_Cancelar End If End Sub Private Sub Form_Unload(Cancel As Integer) Dim n As Integer Dim vTmp As String Dim sTmp As String Dim i As Integer Dim j As Integer Dim sTag As String If iFFAccion <> cFFAc_Cancelar Then ActualizarCombo For i = 0 To 1 n = Combo1(i).ListCount sTag = Trim$(Combo1(i).Tag) If n > NumeroMaximoDeItems Then n = NumeroMaximoDeItems GuardarIni sFFIni, sTag, "NumEntradas", CStr(n) For j = 0 To n - 1 vTmp = "Entrada" & CStr(j) sTmp = Combo1(i).List(j) GuardarIni sFFIni, sTag, vTmp, sTmp Next Next End If Set gsDBR = Nothing End Sub Private Sub ActualizarCombo() '----------------------------------------------------- 'Esta rutina actualiza el contenido de los dos combos, 'si la entrada en el Combo.Text no está, la incluye. 'Se podría usar la llamada al API de Windows. '----------------------------------------------------- 'Actualizar el contenido del Combo Dim sTmp As String 'Para más rapidez... Static i As Integer Static j As Integer Static hallado As Boolean Static k As Integer ' bBuscandoEnCombo = True For k = 0 To 1 hallado = False sTmp = Combo1(k).Text If Len(Trim$(sTmp)) Then j = Combo1(k).ListCount - 1 For i = 0 To j If StrComp(Trim$(sTmp), Trim$(Combo1(k).List(i))) = 0 Then hallado = True Exit For End If Next If Not hallado Then Combo1(k).AddItem sTmp, 0 End If End If Next bBuscandoEnCombo = False End Sub
Este es el listado del módulo con las rutinas de petición de los datos
'--------------------------------------------------------------- 'gsDBR.bas Módulo para el diálogo de Buscar y Reemplazar ' '(c)Guillermo Som, 1996-97 '--------------------------------------------------------------- Option Explicit 'Variables y constantes para buscar/reemplazar Global sFFBuscar As String Global sFFPoner As String Global iFFAccion As Integer 'Constantes para la acción a realizar Global Const cFFAc_Cancelar = True Global Const cFFAc_IDLE = 0 Global Const cFFAc_Buscar = 1 Global Const cFFAc_BuscarSiguiente = 2 Global Const cFFAc_Reemplazar = 3 Global Const cFFAc_ReemplazarTodo = 4 Global Const cFFAc_Aceptar = 5 ' Global sFFIni As String 'Archivo de configuración Public Function gsReemplazar(sBuscar As String, sPoner As String, Optional vModo, Optional vCaption) As Integer 'Prepara el diálogo de Reemplazar Dim iModo As Integer Dim sCaption As String If IsMissing(vModo) Then iModo = cFFAc_Reemplazar Else iModo = vModo End If If IsMissing(vCaption) Then sCaption = "Reemplazar" Else sCaption = CStr(vCaption) End If iFFAccion = cFFAc_IDLE With gsDBR .Caption = sCaption .cmdFindNext.Default = False .cmdFindNext.Visible = False .cmdReplaceAll.Default = True .Combo1(0).Text = sBuscar .Combo1(1).Text = sPoner 'Mostrar el form y esperar a que se tome una acción .Show vbModal 'Do ' .Show ' DoEvents 'Loop Until iFFAccion End With 'Devolver la cadena a reemplazar y buscar sBuscar = sFFBuscar sPoner = sFFPoner 'Si tanto buscar como poner están en blanco, devolver cancelar If Len(Trim$(sBuscar)) = 0 Then If Len(Trim$(sPoner)) = 0 Then iFFAccion = cFFAc_Cancelar End If End If 'Devolver la acción gsReemplazar = iFFAccion End Function Public Function gsBuscar(sBuscar As String, Optional vModo, Optional vCaption) As Integer 'Prepara el diálogo para buscar Dim iModo As Integer Dim sCaption As String If IsMissing(vModo) Then iModo = cFFAc_Buscar Else iModo = vModo End If 'Sólo permitir buscar y buscar-siguiente Select Case iModo Case cFFAc_Buscar, cFFAc_BuscarSiguiente 'está bien, no hay nada que hacer Case Else iModo = cFFAc_Buscar End Select If IsMissing(vCaption) Then sCaption = "Buscar" Else sCaption = CStr(vCaption) End If iFFAccion = cFFAc_IDLE With gsDBR .Caption = sCaption .cmdReplace.Visible = False .lblReplace.Visible = False .cmdReplaceAll.Visible = False .Combo1(1).Visible = False .cmdFindNext.Left = .cmdReplaceAll.Left If iModo = cFFAc_BuscarSiguiente Then .cmdFindNext.Caption = "Siguiente" DoEvents End If .Combo1(0).Text = sBuscar 'Mostrar el form y esperar a que se tome una acción .Show vbModal 'Do ' .Show ' DoEvents 'Loop Until iFFAccion End With 'Devolver la cadena seleccionada/introducida sBuscar = sFFBuscar 'Devolver la acción gsBuscar = iFFAccion End Function Public Sub gsPedirUnValor(spuvTitulo As String, spuvMensaje As String, spuvPregunta As String, spuvValor As String, spuvBoton As String) 'Rutina de propósito general para pedir un valor (00.22 23/May/96) With gsDBR .Caption = spuvTitulo .Combo1(0).Visible = False .lblBuscar.Width = .ScaleWidth - 120 .lblBuscar = spuvMensaje .Combo1(0).Visible = False .cmdReplace.Visible = False .cmdFindNext.Default = False .cmdFindNext.Visible = False .lblReplace = spuvPregunta .cmdReplaceAll.Default = True .cmdReplaceAll.Caption = spuvBoton If Len(Trim$(spuvValor)) Then .Combo1(1).Text = spuvValor Else If .Combo1(1).ListCount Then .Combo1(1).ListIndex = 0 End If End If .Show vbModal End With spuvValor = sFFPoner End Sub
Ahora la rutina de búsqueda quedaría así, (he puesto también que si hay texto seleccionado, se ponga ese para buscar)
Case CMD_BUSCAR 'Buscar registros 'Si no estamos en un Text de búsqueda, salir If ControlActual = 0 Then Exit Sub 'Si hay texto seleccionado... With Text1(ControlActual) If .SelLength > 0 Then sBuscar = "*" & Trim$(.SelText) End If End With If gsBuscar(sBuscar, , "Buscar datos") > cFFAc_IDLE 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
Ahora el tema de Reemplazar, (ya era hora tío!)
4.- Una rutina para Reemplazar datos
Deberás tener estas declaraciones de variables al principio del procedimiento (no es necesario que estén al principio, pero queda como más "mono"):
Dim BusquedaNoHallada As Boolean Dim j As Integer
Este es el código de la rutina de "Reemplazo"
Case CMD_Reemplazar 'Si no estamos en un Text de búsqueda, salir If ControlActual = 0 Then Exit Sub 'Si hay texto seleccionado... With Text1(ControlActual) If .SelLength > 0 Then sBuscar = "*" & Trim$(.SelText) End If End With sFFBuscar = sBuscar sFFPoner = "" iFFAccion = gsReemplazar(sFFBuscar, sFFPoner) If iFFAccion <> cFFAc_Cancelar Then MousePointer = vbHourglass DoEvents sBuscar = Trim$(sFFBuscar) 'Quitar de los caracteres de asteríscos Do While InStr(sFFBuscar, "*") i = InStr(sFFBuscar, "*") sFFBuscar = Left$(sFFBuscar, i - 1) & Mid$(sFFBuscar, i + 1) Loop If Len(sFFBuscar) <> 0 And Len(sFFPoner) <> 0 Then If iFFAccion = cFFAc_Reemplazar Or iFFAccion = cFFAc_ReemplazarTodo Then LblStatus = "Buscando " & sBuscar & "..." DoEvents 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, "Reemplazar" Text1(ControlActual).SetFocus BusquedaNoHallada = True End If YaEstoyAqui = False Do Until BusquedaNoHallada sTmp = Text1(ControlActual).Text 'cambiar... (comprobar si es palabra completa) If Left$(sBuscar, 1) = "*" Then i = InStr(sTmp, sFFBuscar) Else If Left$(sTmp, Len(sFFBuscar)) = sFFBuscar Then i = 1 Else i = 0 End If End If If i Then sTmp = Left$(sTmp, i - 1) & sFFPoner & Mid$(sTmp, i + Len(sFFBuscar)) Text1(ControlActual).Text = sTmp End If If iFFAccion = cFFAc_Reemplazar Then Exit Do 'Cambiar todas las coincidencias en el mísmo text j = 1 Do If Left$(sBuscar, 1) = "*" Then i = InStr(j, sTmp, sFFBuscar) Else If Left$(sTmp, Len(sFFBuscar)) = sFFBuscar Then i = 1 Else i = 0 End If End If If i Then j = i + 1 sTmp = Left$(sTmp, i - 1) & sFFPoner & Mid$(sTmp, i + Len(sFFBuscar)) Text1(ControlActual).Text = sTmp End If Loop While i DoEvents YaEstoyAqui = True Data1.Recordset.FindNext Text1(ControlActual).DataField & " LIKE '" & sBuscar & "*'" If Data1.Recordset.NoMatch Then BusquedaNoHallada = True Else BusquedaNoHallada = False End If YaEstoyAqui = False Loop End If End If MousePointer = vbDefault DoEvents End If
5.- Informar en que posición del TextBox estamos.
Esto es para "rematar" el tema por hoy. Ya que
tenemos el LblStatus, vamos a darle una utilidad.
A mi particularmente me gusta saber en que posición se encuentra el cursor cuando estoy
editando un campo, sobre todo cuantos caracteres me quedan aún. ¿? Suponte que estás en
el campo de Asunto y quieres saber cuantos caracteres puedes utilizar, ya sabes que son
255 el máximo, así que lo que viene a continuación, es para indicarnos eso
precisamente, la posición dentro del Text y cuantos caracteres son en total.
Mejor ver el código, que ya no controlo demasiado...
Private Sub Text1_Click(Index As Integer) LblStatus = "Pos: " & Text1(Index).SelStart + 1 & "/" & Text1(Index).MaxLength End Sub Private Sub Text1_KeyUp(Index As Integer, KeyCode As Integer, Shift As Integer) LblStatus = "Pos: " & Text1(Index).SelStart + 1 & "/" & Text1(Index).MaxLength End Sub
Ahora si que hemos terminado. Espero que saques algunas
cosillas de provecho de todo lo de hoy.
Hasta la próxima entrega, esta vez no digo para cuando que después me
dices que no cumplo mi palabra...