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
  2. Ajustar los controles al redimensionar la ventana
  3. Nuevo Form para Buscar/Reemplazar
  4. Una rutina para Reemplazar datos
  5. Informar en que posici�n dentro del TextBox estamos

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

Form de Buscar y Reemplazar
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...

ir al índice