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

Dim iH As Integer                   'Tamaño mínimo de la ventana
Dim iW As Integer

&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

Const CMD_Reemplazar = 5

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

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

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

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

    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

    Dim BusquedaNoHallada As Boolean
    Dim j As Integer

    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

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