El código de gsNotas versión 3.0

Una utilidad para guardar anotaciones en una base de datos usando ADO

Publicado el 08/Oct/2001
Actualizado el 11/Nov/2001

El código de gsNotas v3.0 en formato zip: gsNotasv3.zip 166 KB

 

 

 

 

 

Los formularios:

El código del formulario de entrada, selección de la base de datos (frmEntrada)


'------------------------------------------------------------------------------
' Entrada.frm                                                       (24/Feb/97)
'
' Formulario para seleccionar el usuario y la base de datos
'
' ©Guillermo 'guille' Som, 1997-2001
'------------------------------------------------------------------------------
Option Explicit
Option Compare Text

Private Sub cmdAceptar_Click()
    Dim sPath As String                         ' path de la base especificada
    Dim sUserPath As String                     ' path del usuario
    Dim sUserBase As String                     ' nombre de la base del usuario
    Const cMsg = "Seleccionar la base"          ' Constante para los MsgBox
    Dim numBases As Integer                     ' Número de bases
    Dim sTmp As String                          ' varios usos
    Dim i As Integer                            ' variable del bucle
    
    ' Comprobar si hay datos introducidos
    sUsuario = Trim$(Text1)
    If Len(sUsuario) = 0 Then
        MsgBox "Debes especificar el nombre del usuario.", vbInformation, cMsg
        ' Posicionarse en el Text1
        Text1.SetFocus
        Exit Sub
    End If
    sTmp = Trim$(Combo1.Text)
    If Len(sTmp) = 0 Then
        MsgBox "No hay ninguna base de datos seleccionada.", vbInformation, cMsg
        Combo1.SetFocus
        Exit Sub
    End If
    
    ' Separar los datos del path y nombre del archivo
    SplitPath sTmp, sPath, sBase
    
    ' Comprobar si la base existe en el combo
    ' Si no existe, añadirla al combo
    i = ActualizarLista(sTmp, Combo1)
    If i = -1 Then
        ' Este caso seguramente nunca se dará, pero...
        MsgBox "Se ha producido un error inesperado al añadir al combo", vbCritical, cMsg
        Unload Me
        Exit Sub
        'End
    End If
    
    ' Esta base, hay que buscarla en las del usuario especificado
    ' el formato será usuarioXX=path_de_la_base
    sTmp = sUsuario & Format$(i + 1, "00")
    ' Comprobar si no se ha especificado el path
    sUserPath = sPath
    If sPath = "" Then
        ' para tomar el que hubiese de antes.
        sUserPath = Trim$(gCD.LeerIni(sFicIni, "General", sTmp, sPath))
    End If
    sUserBase = sUserPath & "\" & sBase
    
    ' Por si la ruta es errónea
    On Local Error Resume Next
    
    If InStr(sUserBase, ".mdb") = 0 Then
        If MsgBox("Atención la base especificada no tiene extensión MDB" & vbCrLf & "¿Intentar cargarla?", vbYesNo + vbInformation, cMsg) = vbNo Then
            ' Posicionarse en el Combo1
            Combo1.Text = sUserBase & ".mdb"
            Combo1.SetFocus
            Exit Sub
        End If
    End If
        
    ' Comprobar si existe "físicamente" la base
    If Len(Dir$(sUserBase)) = 0 Then
        ' No existe, preguntar si se crea
        If MsgBox("La base especificada no existe." & vbCrLf & "'" & sUserBase & "'" & vbCrLf & "¿Quieres crearla?", vbQuestion + vbYesNo, cMsg) = vbYes Then
            On Local Error GoTo 0       ' Si se produce un error, que se pare!
            ' Crear la base
            CrearBase sUserBase
            Err = 0
        Else
            Combo1.SetFocus
            Exit Sub
        End If
    End If
    If Err Then
        MsgBox "Seguramente la ruta especificada, es errónea:" & vbCrLf & "'" & sUserBase & "'", vbInformation, cMsg
        Combo1.SetFocus
        Exit Sub
    End If
    
    On Local Error GoTo 0           ' Si se produce un error, que se pare!
    
    ' Guardar los datos de configuración
    gCD.GuardarIni sFicIni, "General", sTmp, sUserPath
    gCD.GuardarIni sFicIni, "General", "Usuario", sUsuario
    
    numBases = Combo1.ListCount
    gCD.GuardarIni sFicIni, "General", "NumeroBases", CStr(numBases)
    ' Guardar los nombres
    For i = 1 To numBases
        sTmp = "Base" & Format$(i, "00")
        sBase = Combo1.List(i - 1)
        gCD.GuardarIni sFicIni, "General", sTmp, sBase
    Next
    
    ' Asignar el nombre de la base a la variable global
    sBase = sUserBase
    gsNotas.Show
    ' Descargar este form
    Unload Me
End Sub

Private Sub cmdCancelar_Click()
    'Terminar el programa!!!
    Unload Me
    End
End Sub

Private Sub cmdExaminar_Click()
    ' Abrir el control de diálogos comunes y "localizar"
    ' los archivos con extensión MDB
    ' Seleccionar el fichero en el que se empezará la Busqueda
    '
    ' Referencia a la clase de diálogos comunes                     ( 1/Sep/97)
    ' Sólo se usa en este procedimiento                             (07/Ago/00)
    'Dim CommonDialog1 As cgsFileOp
    
    On Local Error Resume Next
    
    'Set CommonDialog1 = New cgsFileOp
    
    With gCD 'CommonDialog1
        .hWnd = hWnd
        .DialogTitle = "Seleccionar Base de Datos"
        .Filter = "Bases (*.mdb)|*.mdb|Todos los archivos (*.*)|*.*"
        .FilterIndex = 1
        .CancelError = True
        .ShowOpen
        If Err = 0 Then
            Combo1.Text = .FileName
        End If
    End With
    
    'Set CommonDialog1 = Nothing
    
    Err = 0
End Sub

Private Sub Form_Load()
    Dim numBases As Long
    Dim sBase As String
    Dim sNum As String
    Dim i As Long
    Dim sPath As String
    Dim sUser As String
    '
    ' Crear el objeto                                               (01/Oct/01)
    Set gCD = New cgsFileOp
    '
    ' Archivo de configuración en el directorio de la aplicación
    sFicIni = gCD.AppPath(False) & "\gsNotas.ini"
    '
    Combo1.Text = ""
    ' Nombre del último usuario
    Text1 = gCD.LeerIni(sFicIni, "General", "Usuario", "")
    sUser = Text1
    ' Leer el número de bases creadas
    numBases = Val(gCD.LeerIni(sFicIni, "General", "NumeroBases"))
    ' Comprobar y leer los nombres
    For i = 1 To numBases
        ' Si queremos usar más de 99 nombres, añade un cero más
        sNum = "Base" & Format$(i, "00")
        sBase = Trim$(gCD.LeerIni(sFicIni, "General", sNum))
        If Len(sBase) Then
            sBase = gCD.NameFromFileName(sBase)
            sPath = Trim$(gCD.LeerIni(sFicIni, "General", sUser & Format$(i, "00")))
            ' Añadir al combo, si no es una cadena vacía
            Combo1.AddItem sPath & "\" & sBase
        End If
    Next
    If Combo1.ListCount Then
        Combo1.ListIndex = 0
    End If
    '
    If gNoCargar = False Then
        ' Si hay datos en el Combo, seleccionar el primero
        If Combo1.ListCount Then
            Combo1.ListIndex = 0
            ' Aquí pondremos las opciones de entrada "personalizada"
            ' es decir sólo si hay bases asignadas.
            If Len(Trim$(Command$)) Then
                ProcesarLineaComandos
            End If
        End If
    End If
End Sub

Private Sub Form_Unload(Cancel As Integer)
    'Liberar memoria
    Set frmEntrada = Nothing
End Sub

Private Sub CrearBase(ByRef sBase As String)
    ' Crear la base de datos indicada
    Dim cat As ADOX.Catalog
    Dim tbl As ADOX.Table
    Dim idx As ADOX.Index
    Dim col As ADOX.Column
    Dim i As Long
    '
    ' Se creará siempre compatible con Access 2000,                 (08/Oct/01)
    ' ya que el otro provider no acepta campos autonuméricos, etc. ¿¿¿???
'    i = MsgBox("¿Quieres crear la base de datos?" & vbCrLf & _
'        "Nota: Se creará con formato compatible con Access 2000 (Microsoft.Jet.OLEDB.4.0)" & vbCrLf & _
'        "Pulsa en Cancelar para terminar el programa.", vbQuestion + vbOKCancel, "Crear Base de datos")
'    If i = vbCancel Then
'        Unload Me
'        Exit Sub
'    End If
    '
    DataProvider = "Microsoft.Jet.OLEDB.4.0"
    '
    Set cat = New ADOX.Catalog
    ' Crear la base de datos
    cat.Create "Provider=" & DataProvider & ";" & _
               "Data Source=" & sBase & ";"
    '
    Set tbl = New ADOX.Table
    Set idx = New ADOX.Index
    '
    sTabla = "Tareas"
    '
    ' Crear la nueva tabla
    With tbl
        .Name = sTabla
        ' Crear los campos y añadirlos a la tabla.
        ' Es un "rollo" el que los campos se clasifiquen, ya que
        ' en el código del programa está pensado que siga una secuencia:
        '
        ' Esto hay que hacerlo antes de añadir la tabla a la colección de tablas
        '
        '.Columns.Append "c1ID", adInteger
        Set col = New ADOX.Column
        With col
            .Name = "c1ID"
            .Type = adInteger
            Set .ParentCatalog = cat
            .Properties("AutoIncrement") = True
        End With
        .Columns.Append col
        '
        .Columns.Append "c2Fecha", adDate
        '
        ' Para Access 2000
        .Columns.Append "c3Asunto", adVarWChar, 255
        .Columns.Append "c4Descripcion", adLongVarWChar ' Una cadena larga, (Memo)
        .Columns.Append "c5FechaInicio", adDate
        .Columns.Append "c6FechaTermino", adDate
        .Columns.Append "c7Terminada", adInteger
        .Columns.Append "c8Apartado", adVarWChar, 25
        '
        .Columns("c2Fecha").Attributes = adColNullable      ' Permite contener nulos
        .Columns("c3Asunto").Attributes = adColNullable
        .Columns("c4Descripcion").Attributes = adColNullable
        .Columns("c5FechaInicio").Attributes = adColNullable
        .Columns("c6FechaTermino").Attributes = adColNullable
        .Columns("c7Terminada").Attributes = adColNullable
        .Columns("c8Apartado").Attributes = adColNullable
    End With
    With idx
        .Name = "Indice" & sTabla
        .Columns.Append "c1ID", adInteger
    End With
    tbl.Indexes.Append idx
    '
    ' Añadir la nueva tabla a la base de datos
    cat.Tables.Append tbl
    '
    Set idx = Nothing
    Set tbl = Nothing
    Set cat = Nothing
    '
    MsgBox "Nueva base de datos " & sBase & " creada.", vbInformation
End Sub

Private Sub ProcesarLineaComandos()
    'La forma de los parámetros será:
    '/U nombre_usuario /B nombre_base
    Dim sTmp As String
    Dim sUser As String
    Dim sBase As String
    Dim i As Long
    
    Show
    DoEvents
    
    sTmp = Trim$(Command$)
    
    'tomar el nombre del usuario
    i = InStr(sTmp, "/U")
    If i Then
        sUser = Mid$(sTmp, i + 2)
        i = InStr(sUser, "/")
        If i Then
            sUser = Left$(sUser, i - 1)
        End If
        sUser = Trim$(sUser)
        Text1 = sUser
    End If
    'Ahora la base:
    i = InStr(sTmp, "/B")
    If i Then
        sBase = Mid$(sTmp, i + 2)
        i = InStr(sBase, "/")
        If i Then
            sBase = Left$(sBase, i - 1)
        End If
        sBase = Trim$(sBase)
        'Comprobar si la base existe en el combo
        '   Si no existe, añadirla al combo
        i = ActualizarLista(sBase, Combo1)
        If i = -1 Then
            'Este caso seguramente nunca se dará, pero...
            MsgBox "Se ha producido un error inesperado al añadir al combo", vbCritical, "Cargando automáticamente"
            Unload Me
            End
        End If
        Combo1.Text = sBase
    End If
    'Hacer como si se hubiese pulsado en aceptar
    cmdAceptar_Click
End Sub

El código del formulario principal (gsNotas.frm)


'------------------------------------------------------------------------------
' Form para la entrada de datos de las Tareas                       ( 7/Mar/97)
'
' Primera tentativa:      7/Mar/97
'
' Revisiones:
'
'   21/May/97   Arreglo en los datos mostrados en la consulta
'    5/Jul/97   Buscar usando orden SQL
'    2/Ago/97   Nuevas opciones Avanzadas: Copiar y Nuevo (para usar con los mails)
'               Se guardan los últimos items de la lista de buscar
'
'    3/Sep/97   Varios añadidos y mejoras:
'               Editar el texto en form aparte, imprimirlo, etc.
'    6/Sep/97   En buscar, poder hacerlo de atrás a adelante y
'               palabra completa (===por hacer)
'   16/Sep/97   Mejoras al usar F4 y quitar los intros al principio
'               cuando se usa xxxAvan
'               Añadido Bookmarks, para ir rápidamente a los registros
'   17/Sep/97   Algunas mejoras en los bookmarks y quitado el From: guille...
'    5/Oct/97   Añado nueva opción al menú de Registros para ampliar campo
'   13/Nov/97   Usando RichTextBox (al final lo quité)
'   22/Feb/98   Arreglo del "bug" de los dos puntos...
'   24/Mar/98   Vuelvo a usar el RichTextBox
'   29/Mar/98   Arreglo el error 3426 cuando añadía un nuevo dato,
'               (aunque ese error no ocurría siempre, por suerte)
'               Sigue ocurriendo... la verdad es que no se dónde...
'   31/Mar/98   He hecho varias pruebas más... ahora parece que va bien
'    2/Abr/98   Le añado al combo de búsqueda el que muestre las
'               palabras conforme se va escribiendo
'   19/Ago/99   Modificaciones en el formulario de buscar (en IniciarCombo)
'
' Nueva versión (2.00.xxxx)
'    6/Ago/2000 Panel de vistas y botones configurables
'   09/Ago/2000 Ya está operativa la configuración de los botones
'   10/Ago/2000 Algunos arreglillos varios
'   10/Nov/2000 Usando DAO 3.6 para poder usar bases de Access 2000
'
' Nueva versión (3.00.xxxx) usando ADO
'   01/Oct/2001 Actualizado para usar ADO y algunos otros cambios
'   08/Oct/2001 Arreglo de algunos bugs
'   14/Oct/2001 Arreglado un problema de tabulación en gsQBE
'
' ©Guillermo 'guille' Som, 1997-2001
' /U Guillermo /BNotasGuille.mdb
'------------------------------------------------------------------------------
Option Explicit
Option Compare Text

' Valores para usar con ADO                                         (01/Oct/01)
Private RsBuscar As ADODB.Recordset         ' para la rutina de búsqueda
Private WithEvents Data1 As ADODB.Recordset ' Sustituye al control Data
'
'
Dim NumApartadosAnt As Long                 ' Los apartados antes de crearlos
'
Dim buscAtras As Boolean                    ' Dirección de búsqueda
Dim buscCompleta As Boolean                 ' Palabra completa

'Dim RsBuscar As Recordset                   ' para la rutina de búsqueda ( 5/Jul/97)
'Dim Db As Database                          ' Ahora se mantiene abierta

Dim NoActualizar As Boolean                 ' para controlar el Reposition

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

Dim ControlActual As Integer                ' Para saber cual es el text que está activo
Dim YaEstoyAqui As Boolean                  ' Para el Text2
' constantes para los botones de acción
' Según el ToolBar
Const CMD_NuevoAvan = 2
Const CMD_Nuevo = 3
Const CMD_Actualizar = 4
Const CMD_Borrar = 5
Const CMD_PegarAvan = 7
Const CMD_Buscar = 9
Const CMD_BuscarSiguiente = 10
Const CMD_BookmarkLista = 12
Const CMD_BookmarkNuevo = 13
Const CMD_BookmarkAnterior = 14
Const CMD_BookmarkSiguiente = 15
Const CMD_Consulta = 17
Const CMD_Clasificar = 19
Const CMD_Compactar = 21
Const CMD_Configurar = 23
Const CMD_Acerca = 25
Const CMD_Salir = 27
'
Const CMD_Reemplazar = 105
'
' Las variables de edición están declaradas globalmente en gsDBR.bas
' para usar los procedimientos genéricos de búsqueda     (31/Ago/97)
'
'Const CMD_BuscarActual = 101
'Const CMD_BuscarSigActual = 102
'Const CMD_ReemplazarActual = 103
'Const CMD_SeleccionarTodo = 104
'
'Constantes para el menú de Edición
'Const mEdDeshacer = 0
'Const mEdCortar = 1
'Const mEdCopiar = 2
'Const mEdPegar = 3
'Const mEdSep1 = 4
'Const mEdBuscarActual = 5
'Const mEdBuscarSigActual = 6
'Const mEdReemplazarActual = 7
'Const mEdSep2 = 8
'Const mEdSeleccionarTodo = 9
'
' Constantes para las acciones de actualización, etc del Data
Const EM_NOTHING = 0
Const EM_EDIT = 1
Const EM_ADDNEW = 2
' Constantes para el campo
Const cID = 0
Const cFecha = 1
Const cAsunto = 2
Const cDescripcion = 3
Const cFechaInicio = 4
Const cFechaTermino = 5
Const cTerminada = 6
Const cApartado = 7

Private Sub CompactarBase()
    ' Compactar una base de datos con ADO
    Dim sDBTmp As String
    Dim je As JRO.JetEngine
    Dim i As Long
    '
    On Error GoTo ErrCompactar
    '
    Set je = New JRO.JetEngine
    '
    ' deshabilitar los botones
    With Toolbar1
        For i = 1 To CMD_Acerca - 1
            .Buttons(i).Enabled = False
        Next
    End With
    '
    ' Cerrar la conexión y recordset actual,                        (08/Oct/01)
    ' ya que tiene que estar abierto en modo exclusivo
    '
    Data1.Close
    Set Data1 = Nothing
    Cnn.Close
    Set Cnn = Nothing
    '
    ' Crear un nombre "medio" aleatorio
    sDBTmp = "DBT_" & Format$(Minute(Now), "00") & Format$(Second(Now), "00") & ".mdb"
    ' Asegurarnos de que no existe una base con el nombre temporal
    If Len(Dir$(sDBTmp)) Then
        Kill sDBTmp
    End If
    '
    LblStatus(1).Tag = LblStatus(1).Caption
    LblStatus(1).Caption = " Compactando la base de datos..."
    LblStatus(1).Refresh
    '
    ' Compactar la base de datos
    je.CompactDatabase "Data Source=" & sBase & ";", _
                       "Data Source=" & sDBTmp & ";"
    '
    ' Eliminar la base de datos original
    Kill sBase
    '
    ' Renombrar la base temporal con el original
    Name sDBTmp As sBase
    '
    LblStatus(1).Caption = " Base de datos compactada."
    LblStatus(1).Refresh
    '
CompactarSalir:
    ' habilitar los botones
    With Toolbar1
        For i = 1 To CMD_Acerca - 1
            .Buttons(i).Enabled = True
        Next
    End With
    CargarTabla
    '
    LblStatus(1).Caption = LblStatus(1).Tag
    LblStatus(1).Refresh
    '
    Exit Sub
    '
ErrCompactar:
    ' Mostrar el mensaje de error
    MsgBox "Error al compactar la base de datos:" & vbCrLf & _
            Err.Number & " " & Err.Description, _
            vbExclamation, "Error al compactar la base de datos"
    Err.Clear
    LblStatus(1).Caption = " *** Error al compactar la base de datos ***"
    LblStatus(1).Refresh
    '
    Resume CompactarSalir
End Sub

Private Sub CargarTabla()
    Dim Rs As Recordset
    Dim Fd As Field
    Dim i As Long
    Dim j As Long
    Dim HayDatos As Boolean
    
    sTabla = "Tareas"
    '
    ' Para que no se trate de ahcer nada hasta que se carguen los datos
    NoActualizar = True
    '
    ' Para usar con ADO                                             (01/Oct/01)
    CrearConexion Cnn, True
    ' Asignar el recordset Data1
    Set Data1 = New ADODB.Recordset
    Data1.Open "select * from " & sTabla & " order by " & sClasif, Cnn, adOpenDynamic, adLockOptimistic
    '
    ' Crear el recordset para leer la estructura de la tabla
    Set Rs = New ADODB.Recordset
    Rs.Open sTabla, Cnn, adOpenDynamic, adLockOptimistic, adCmdTable
    '
    ' Número de campos, empezando por cero
    j = Rs.Fields.Count - 1
    NumCampos = j
    
    ' Asegurarse que los texts no están asociados
    For i = 0 To j - 1
        With Text1(i)
            .DataField = ""
            .Text = ""
        End With
    Next
    RichTextBox1.Text = ""
    RichTextBox1.TextRTF = ""
    '
    '-(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.DefinedSize  ' Size
            .Tipo = Fd.Type
        End With
        
        If InStr(Fd.Name, "Descripcion") Then
            'Set RichTextBox1.DataSource = Data1
            RichTextBox1.DataField = Fd.Name
            ' Asignarlo también en el Text(i) por si se usa en bucles
            Text1(i).DataField = Fd.Name
        Else
            With Text1(i)
                ' El DataSource da error en tiempo de ejecución
                ' así que debe estar asignado en las propiedades del form
                'Set .DataSource = Data1
                .DataField = Fd.Name
                ' Asignar el tamaño máximo de cada campo
                Select Case Fd.Type
                Case dbMemo
                    .MaxLength = 64000
                Case dbDate
                    .MaxLength = 10
                Case dbText
                    .MaxLength = Fd.DefinedSize
                Case Else
                    .MaxLength = 15
                End Select
            End With
        End If
    Next
    Rs.Close
    Set Fd = Nothing
    Set Rs = Nothing
    '
    HayDatos = True
    '
    If HayDatos Then
        If Not Data1.EOF Then
            HayDatos = True
        Else
            HayDatos = False
        End If
    End If
    '
    If HayDatos Then
        Data1.MoveLast
    Else
        ' No hay datos en la base aún    (16/Sep/95)
        MsgBox "Antes de empezar a introducir datos," & vbCrLf & "debes seleccionar NUEVO.", 48
    End If
    '
    NoActualizar = False
    
    cmdView(0).BackColor = vbInactiveCaptionText
    '
    Err = 0
    On Error GoTo 0
    '
    LblStatus(1) = "User: " & sUsuario & ", Tabla: " & sTabla & ", Base: " & sBase & ", (" & DataProvider & ")"
End Sub

Private Sub cboApartados_Change()
    ' Asignar el apartado al que corresponde esta anotación         (07/Ago/00)
'    Text1(cApartado) = cboApartados.Text
End Sub

Private Sub cboApartados_Click()
    ' Asignar el apartado al que corresponde esta anotación         (07/Ago/00)
'    Text1(cApartado) = cboApartados.Text
End Sub

Private Sub Check1_Click()
    'Actualizar el Text asociado
    Text1(cTerminada).Text = Check1.Value
End Sub

Private Sub Check1_GotFocus()
    ControlActual = 0
End Sub

Private Sub cmdAccion_Click(Index As Integer)
    Static esNuevo As Boolean
    Dim i As Long
    Static sBuscar As String
    Dim sTmp As String
    Dim BusquedaNoHallada As Boolean
    Dim j As Long
    Dim sBookmark As String
    Dim qID As Long
    
    LblStatus(1).Tag = LblStatus(1).Caption
    
    Select Case Index
    Case CMD_Nuevo              ' Nuevo registro
        If Not esNuevo Then
            ' Probar a ver si así se evita el error      (30/Mar/98)
            AñadirRegistro
            '
            NoActualizar = False
            esNuevo = False
            
            On Local Error Resume Next
            Data1.MoveLast
            Err = 0
            On Local Error GoTo 0
            '******************************
            '     NO ACTUALIZAR AQUÍ
            'DoEvents
            'cmdAccion_Click CMD_Actualizar
            '******************************
            'Text1(cAsunto).SetFocus
            Text1(cFecha).SetFocus
        End If
    Case CMD_NuevoAvan              ' Nuevo, pegar mensaje... ( 2/Ago/97)
        cmdAccion_Click CMD_Nuevo
        PegarMensaje
        ' Dejar esta línea, aunque esté en PegarMensaje  (16/Sep/97)
        cmdAccion_Click CMD_Actualizar
        Exit Sub
    Case CMD_Actualizar
        esNuevo = False
        ' Guardar el contenido de cada uno de los campos
        'On Local Error Resume Next
        ActualizarRegistro
        If ControlActual = 0 Then
            Text1(1).SetFocus
        End If
    Case CMD_PegarAvan
        PegarMensaje
        Exit Sub
    Case CMD_Borrar             ' Borrar registro
        If MsgBox("¿Seguro que quieres borrar este registro?", 4 + 32 + 256) = 6 Then
            On Local Error Resume Next
            With Data1
                NoActualizar = True
                fBookmarks.Borrar !c1ID
                .Delete
                NoActualizar = False
                If Not .EOF Then
                    .MoveLast
                Else
                    Data1Caption = "No hay registros"
                End If
                If Err Then
                    Err = 0
                    Data1Caption = "No hay registros"
                End If
            End With
            On Local Error GoTo 0
        End If
    Case CMD_Buscar             ' Buscar registros
        ' Si no estamos en un Text de búsqueda, salir
        If ControlActual = 0 Then Exit Sub
        
        If ControlActual = cDescripcion Then
            With RichTextBox1
                If .SelLength > 0 Then
                    sBuscar = "%" & Trim$(.SelText)
                Else
                    sBuscar = "%"
                End If
            End With
        Else
            ' Si hay texto seleccionado...
            With Text1(ControlActual)
                If .SelLength > 0 Then
                    sBuscar = "%" & Trim$(.SelText)
                Else
                    sBuscar = "%"
                End If
            End With
        End If
        ' Para "personalizar" la sección de búsqueda...
        gsDBR.Combo1(0).Tag = "Buscar_" & sUsuario
        ' Para que se marque la búsqueda hacia atrás.
        iFFAtras = True
        If gsBuscar(sBuscar, cFFAc_Buscar + cFFAc_Atras, "Buscar datos") > cFFAc_IDLE Then
            sBuscar = Trim$(sBuscar)
            ' Cambiar los comodines antiguos por los nuevos         (01/Oct/01)
            sBuscar = Replace(sBuscar, "*", "%")
            sBuscar = Replace(sBuscar, "?", "_")
            '
            If Len(sBuscar) Then
                buscAtras = iFFAtras
                LblStatus(1) = "Buscando " & sBuscar & "..."
                DoEvents
                ' Usar una rutina del tipo consulta (SQL)
                qID = BuscarEnBase(Campos(ControlActual).Nombre & " LIKE '" & sBuscar & "%'")
                If qID Then
                    Data1.Find "c1ID = " & CStr(qID), , adSearchForward, 1
                    If Data1.EOF Then
                        qID = 0&
                    End If
                End If
                If qID = 0& Then
                    Beep
                    MsgBox "No se ha hallado el dato buscado en el campo: " & Campos(ControlActual).Nombre, vbOK + vbInformation, "Buscar"
                    If ControlActual = cDescripcion Then
                        RichTextBox1.SetFocus
                    Else
                        Text1(ControlActual).SetFocus
                    End If
                    Data1.MoveLast
                Else
                    sTmp = sBuscar
                    If Left(sTmp, 1) = "%" Then
                        sTmp = Mid$(sTmp, 2)
                    End If
                    If ControlActual = cDescripcion Then
                        With RichTextBox1
                            i = InStr(.Text, sTmp)
                            .SelStart = i - 1
                            .SelLength = Len(sTmp)
                            ' posicionarse en ese control
                            .SetFocus
                        End With
                    Else
                        ' 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
                End If
            End If
        End If
    Case CMD_BuscarSiguiente
        If Len(sBuscar) = 0 Then
            cmdAccion_Click CMD_Buscar
        Else
            LblStatus(1) = "Buscando " & sBuscar & "..."
            DoEvents
            qID = BuscarEnBase("")
            If qID Then
                Data1.Find "c1ID = " & CStr(qID), , adSearchForward, 1
                If Data1.EOF Then
                    qID = 0&
                End If
            End If
            If qID = 0& Then
                Beep
                MsgBox "No se han hallado más coincidencias del dato buscado en el campo: " & Campos(ControlActual).Nombre, vbOK + vbInformation, "Buscar Siguiente"
                If ControlActual = cDescripcion Then
                    RichTextBox1.SetFocus
                Else
                    Text1(ControlActual).SetFocus
                End If
                Data1.MoveLast
            Else
                sTmp = sBuscar
                If Left(sTmp, 1) = "*" Then
                    sTmp = Mid$(sTmp, 2)
                End If
                If ControlActual = cDescripcion Then
                    With RichTextBox1
                        i = InStr(.Text, sTmp)
                        If i Then
                            .SelStart = i - 1
                            .SelLength = Len(sTmp)
                        End If
                        ' posicionarse en ese control
                        .SetFocus
                    End With
                Else
                    ' Seleccionar el texto hallado
                    With Text1(ControlActual)
                        i = InStr(.Text, sTmp)
                        If i Then
                            .SelStart = i - 1
                            .SelLength = Len(sTmp)
                        End If
                        ' posicionarse en ese control
                        .SetFocus
                    End With
                End If
            End If
        End If
    Case CMD_Reemplazar
        ' Si no estamos en un Text de búsqueda, salir
        If ControlActual = 0 Then Exit Sub
        If ControlActual = cDescripcion Then
            With RichTextBox1
                If .SelLength > 0 Then
                    sBuscar = "%" & Trim$(.SelText)
                End If
            End With
        Else
            ' Si hay texto seleccionado...
            With Text1(ControlActual)
                If .SelLength > 0 Then
                    sBuscar = "%" & Trim$(.SelText)
                End If
            End With
        End If
        sFFBuscar = sBuscar
        sFFPoner = ""
        ' Personalizar las secciones de buscar/reemplazar
        gsDBR.Combo1(0).Tag = "Buscar_" & sUsuario
        gsDBR.Combo1(1).Tag = "Reemplazar_" & sUsuario
        iFFAccion = gsReemplazar(sFFBuscar, sFFPoner)
        If iFFAccion <> cFFAc_Cancelar Then
            MousePointer = vbHourglass
            DoEvents
            sBuscar = Trim$(sFFBuscar)
            ' Por si se indican comodines NO compatibles            (01/Oct/01)
            sBuscar = Replace(sBuscar, "*", "%")
            sBuscar = Replace(sBuscar, "?", "_")
            sFFBuscar = sBuscar
            '
            ' 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(1) = "Buscando " & sBuscar & "..."
                    DoEvents
                    qID = BuscarEnBase(Campos(ControlActual).Nombre & " LIKE '" & sBuscar & "%'")
                    If qID Then
                        Data1.Find "c1ID = " & CStr(qID), , adSearchForward, 1
                        If Data1.EOF Then
                            qID = 0&
                        End If
                    End If
                    If qID = 0& Then
                        Beep
                        MsgBox "No se ha hallado el dato buscado en el campo: " & Campos(ControlActual).Nombre, vbOK + vbInformation, "Reemplazar"
                        If ControlActual = cDescripcion Then
                            RichTextBox1.SetFocus
                        Else
                            Text1(ControlActual).SetFocus
                        End If
                        BusquedaNoHallada = True
                        Data1.MoveLast
                    End If
                    Do Until BusquedaNoHallada
                        If ControlActual = cDescripcion Then
                            sTmp = RichTextBox1.Text
                        Else
                            sTmp = Text1(ControlActual).Text
                        End If
                        ' 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))
                            If ControlActual = cDescripcion Then
                                RichTextBox1.Text = sTmp
                            Else
                                Text1(ControlActual).Text = sTmp
                            End If
                        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))
                                If ControlActual = cDescripcion Then
                                    RichTextBox1.Text = sTmp
                                Else
                                    Text1(ControlActual).Text = sTmp
                                End If
                            End If
                        Loop While i
                        DoEvents
                        qID = BuscarEnBase("")
                        If qID Then
                            Data1.Find "c1ID = " & CStr(qID), , adSearchForward, 1
                            If Data1.EOF Then
                                BusquedaNoHallada = True
                                Data1.MoveLast
                            Else
                                BusquedaNoHallada = False
                            End If
                        Else
                            BusquedaNoHallada = True
                        End If
                    Loop
                End If
            End If
            MousePointer = vbDefault
            DoEvents
        End If
    End Select
    
    LblStatus(1) = LblStatus(1).Tag
End Sub

Private Sub cmdMover_Click(Index As Integer)
    ' Moverse por el recordset
    On Error Resume Next
    Err = 0
    '
    ' Antes de mover el registro, actualizar los datos que haya
    ' NOTA: ESTO A LA LARGA DA PROBLEMAS...
    '       COMO MUCHO, AVISAR DE QUE LOS DATOS HAN CAMBIADO
'    'ActualizarRegistro
    '
    With Data1
        Select Case Index
        Case 0  ' Primero
            .MoveFirst
        Case 1  ' Anterior
            .MovePrevious
        Case 2  ' Siguiente
            .MoveNext
        Case 3  ' Último
            .MoveLast
        End Select
        '
        ' Si estamos fuera de los límites...
        If .BOF Then
            .MoveFirst
        ElseIf .EOF Then
            .MoveLast
        End If
    End With
    '
    If Text1(cAsunto).Visible Then
        Text1(cAsunto).SetFocus
    End If
    '
    Err = 0
End Sub

Private Sub cmdView_Click(Index As Integer)
    ' Al hacer click en estos botones,                              (07/Ago/00)
    ' mostrar los mensajes asociados
    '
    Dim i As Long
    
    On Local Error Resume Next
    
    For i = 0 To NumApartados
        cmdView(i).BackColor = vbButtonFace
    Next
    
    Err = 0
    '
    NoActualizar = True
    '
    Data1.Close
    Set Data1 = Nothing
    Set Data1 = New ADODB.Recordset
    If Index = 0 Then
        ' Todos los datos
        'Data1.RecordSource = "select * from " & sTabla & " order by " & sClasif
        Data1.Open "select * from " & sTabla & " order by " & sClasif, Cnn, adOpenDynamic, adLockOptimistic
    Else
        ' Sólo los del Apartado indicado
        'Data1.RecordSource = "select * from " & sTabla & " WHERE Apartado = '" & cmdView(Index).Caption & "' order by " & sClasif
        Data1.Open "select * from " & sTabla & " WHERE Apartado = '" & cmdView(Index).Caption & "' order by " & sClasif, Cnn, adOpenDynamic, adLockOptimistic
    End If
    '
    ' Da error 13-Type Mismatch si no hay registros
    'Data1.Refresh
    Data1.MoveLast
    '
    If Data1.EOF Then
        'Data1.RecordSource = "select * from " & sTabla & " order by " & sClasif
        Data1.Open "select * from " & sTabla & " order by " & sClasif, Cnn, adOpenDynamic, adLockOptimistic
    End If
    '
    NoActualizar = False
    Data1.MoveLast
    '
    cmdView(Index).BackColor = vbGrayText ' vbInactiveCaptionText ' vbButtonShadow
    '
    Err = 0
End Sub

Private Sub Data1_MoveComplete(ByVal adReason As ADODB.EventReasonEnum, ByVal pError As ADODB.Error, adStatus As ADODB.EventStatusEnum, ByVal pRecordset As ADODB.Recordset)
    Dim sTmp As String
    Dim i As Long
    '
    If NoActualizar Then Exit Sub
    
    On Local Error Resume Next
    
    If Not Data1.EOF Then
        ' Esta rutina se ejecuta cuando un registro es el
        ' registro actual, (cada vez que se actualiza)
        If Not IsNull(Data1!c1ID) Then _
            sTmp = Data1!c1ID
        
        If Not IsNull(Data1!c2Fecha) Then _
            sTmp = sTmp & ", " & Data1!c2Fecha
            
        If Not IsNull(Data1!c3Asunto) Then _
            sTmp = sTmp & ", " & Data1!c3Asunto
            
        If Len(sTmp) Then
            Data1Caption = Replace(sTmp, vbCrLf, " ") ' QuitarCaracter(sTmp, vbCrLf, " ")
        Else
            Data1Caption = " Registro en blanco."
        End If
        If Not YaEstoyAqui Then
            If Not IsNull(Data1!c1ID) Then
                Text2.Text = Data1!c1ID
                If Val(Data1!c7Terminada) Then
                    Check1.Value = 1
                Else
                    Check1.Value = 0
                End If
                cboApartados.Text = Data1!c8Apartado
                If Err Then
                    cboApartados.ListIndex = 0
                End If
                '
                For i = 1 To Text1.Count - 1
                    If i = cDescripcion Then
                        'RichTextBox1.Text = Data1.Fields(RichTextBox1.DataField) & ""
                        RichTextBox1.TextRTF = Data1.Fields(RichTextBox1.DataField) & ""
                    Else
                        Text1(i).Text = Data1.Fields(Text1(i).DataField) & ""
                    End If
                Next
                Err = 0
            End If
        End If
    Else
        Data1Caption = "No hay registros."
        Text2.Text = Null
    End If
    Err = 0
    On Error GoTo 0
End Sub

Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)
    ' Para los Bookmarks siguiente (Ctrl++) o anterior (Ctrl+-)     (01/Oct/01)
    If (Shift And vbCtrlMask) > 0 Then
        Select Case KeyCode
        Case vbKeyAdd, 187      ' Siguiente Bookmark
            mnuBookmarks_Click 3
        Case vbKeySubtract, 189 ' Bookmark anterior
            mnuBookmarks_Click 2
        End Select
    End If
End Sub

Private Sub Form_Resize()
    Static YaHeEstado As Boolean
    Dim i As Long
    
    ' 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
    
    ' Si el tamaño de la ventana es menor que el del form,
    ' ajustar el tamaño...                   (11/Oct/98)
    '
    ' Comprobar el ancho
    If Screen.Width < ScaleWidth Then
        Width = iW
        Exit Sub
    End If
    ' Comprobar el alto
    If Screen.Height < ScaleHeight Then
        Height = iH
        Top = 0
        Exit Sub
    End If
    '
    ' Ajustar el tamaño de los contenedores                         (06/Ago/00)
    picView.Move 60, 480, picView.Width, ScaleHeight - 480 - StatusBar1.Height
    picCont.Move picView.Width + 90, 480, ScaleWidth - picView.Width - 120, ScaleHeight - 480 - StatusBar1.Height
    '
    With Text2
        .Left = picCont.ScaleWidth - .Width - 90
        Label1(0).Left = .Left - Label1(0).Width - 30
    End With
    cmdMover(3).Left = Label1(0).Left - 540
    cmdMover(2).Left = cmdMover(3).Left - 330
    With Data1Caption
        .Width = cmdMover(2).Left - .Left - 30
    End With
    'Data1.Width = Label1(0).Left - 180
    
    ' El textBox de Asunto
    With Text1(cAsunto)
        .Width = picCont.ScaleWidth - .Left - 90
    End With
    
'    ' move es más rápido que efectuar los 3 cambios
'    LblStatus(0).Move 30, picCont.ScaleHeight - 225
'    LblStatus(2).Move 30, LblStatus(0).Top - 330
    '
    ' El campo Apartado                                             (06/Ago/00)
    Text1(cApartado).Top = picCont.ScaleHeight - 375
    Label1(cApartado).Top = Text1(cApartado).Top + 30
    cboApartados.Top = Text1(cApartado).Top
    '
    ' El alto del text de la descripción
    With RichTextBox1
        .Width = picCont.ScaleWidth - .Left - 90
        '.Height = LblStatus(0).Top - .Top - 60
'        .Height = picCont.ScaleHeight - .Top - 60
        .Height = Text1(cApartado).Top - .Top - 60
'        LblStatus(1).Top = LblStatus(0).Top
'        LblStatus(1).Width = .Width
    End With
    
    ' Asegurarnos de que no se actualice la primera vez que se carga.
    If YaHeEstado Then
        ' Guardar el tamaño y la posición
        ' Si está maximizado
        If WindowState = vbNormal Then
            gCD.GuardarIni sFicIni, "Posición_" & sUsuario, "gsNotas_Left", CStr(Left)
            gCD.GuardarIni sFicIni, "Posición_" & sUsuario, "gsNotas_Top", CStr(Top)
            gCD.GuardarIni sFicIni, "Posición_" & sUsuario, "gsNotas_Width", CStr(Width)
            gCD.GuardarIni sFicIni, "Posición_" & sUsuario, "gsNotas_Height", CStr(Height)
            gCD.GuardarIni sFicIni, "Posición_" & sUsuario, "gsNotas_Maximizado", "0"
        Else
            gCD.GuardarIni sFicIni, "Posición_" & sUsuario, "gsNotas_Maximizado", "1"
        End If
    End If
    YaHeEstado = True
End Sub

Private Sub LblStatus_Change(Index As Integer)
    StatusBar1.Panels("Status" & CStr(Index)) = LblStatus(Index)
End Sub

Private Sub mnuAcercaDe_Click()
    ' Mostrar la información del programa, versión, etc.
    Dim sMsg As String
    With App
        sMsg = vbCrLf
        sMsg = sMsg & "gsNotas v" & Format$(.Major, "00") & "." & Format$(.Minor, "00") & "." & Format$(.Revision, "0000") & vbCrLf & vbCrLf
        'sMsg = sMsg & .FileDescription & vbCrLf
        sMsg = sMsg & .Comments & vbCrLf & vbCrLf
        sMsg = sMsg & .ProductName & vbCrLf & vbCrLf
        sMsg = sMsg & .LegalCopyright '& vbCrLf & vbCrLf
    End With
    MsgBox sMsg, vbInformation, "Acerca de..."
End Sub

Private Sub mnuBookmark_Click()
    'Comprobar si ya hay elementos en la lista
    Dim bEnabled As Boolean
    Dim i As Integer
    
    i = fBookmarks.Lista.ListCount
    If i < 2 Then
        bEnabled = False
    Else
        bEnabled = True
    End If
    mnuBookmarks(2).Enabled = bEnabled
    mnuBookmarks(3).Enabled = bEnabled
End Sub

Private Sub mnuBookmarks_Click(Index As Integer)
    Dim i As Integer
    Dim lngID As Long
    Dim bEnabled As Boolean
    
    With fBookmarks
        'Acción según la opción seleccionada
        Select Case Index
        Case 0  ' Lista
            .Show vbModal
        Case 1  ' Nuevo
            .Nuevo Data1!c1ID, Data1!c3Asunto
            .ActualizarToolBar
        Case 2, 3   ' Anterior y Siguiente
            If Index = 2 Then
                lngID = .Anterior
            Else
                lngID = .Siguiente
            End If
            ' posicionarse
            If lngID Then
                Data1.Find "c1ID = " & CStr(lngID), , adSearchForward, 1
            End If
        End Select
    End With
End Sub

Private Sub mnuBorrar_Click()
    cmdAccion_Click CMD_Borrar
End Sub

Private Sub mnuClasificar_Click()
    Accion CMD_Clasificar
End Sub

Private Sub mnuCompactar_Click()
    Accion CMD_Compactar
End Sub

Private Sub mnuConsulta_Click()
    gsQBE.Show vbModal
    If MostrarConsulta!Command1.Caption = "" Then
        Unload MostrarConsulta
    Else
        MostrarConsulta.Show
    End If
End Sub

Private Sub mnuConsultaSQL_Click()
    fExecute.Show , Me
End Sub

Private Sub mnuEd_Click()
    'Llama al procedimiento genérico de edición     (31/Ago/97)
    menuEdi
End Sub

Private Sub mnuEdicion_Click(Index As Integer)
    'Procedimiento genérico de los comandos de edición  (31/Ago/97)
    menuEdicion Index
End Sub

Private Sub mnuGuardar_Click()
    cmdAccion_Click CMD_Actualizar
End Sub

Private Sub mnuNuevo_Click()
    cmdAccion_Click CMD_Nuevo
End Sub

Private Sub mnuNuevoAvan_Click()
    cmdAccion_Click CMD_NuevoAvan
End Sub

Private Sub mnuPegarAvan_Click()
    cmdAccion_Click CMD_PegarAvan
End Sub

Private Sub mnuReg_Click()
    'Por si se quiere habilitar sólo
    'si el campo de texto actual es cDescripcion        ( 1/Sep/97)
    'mnuRegImprimir.Enabled = (ControlActual = cDescripcion)
End Sub

Private Sub mnuRegAmpDesc_Click()
    Dim Index As Integer
    
    If ActiveControl.Name = "Text1" Then
        Index = ActiveControl.Index
        
        'Si es el cuadro de asunto o descripción
        'mostrar el form del Mini-Editor
        Select Case Index
        Case cAsunto, cDescripcion
            With fMiniEditor
                '.cmdImprimir.Enabled = False
                If Index = cDescripcion Then
                    .txtEditor.Text = RichTextBox1.Text
                Else
                    .txtEditor.Text = Text1(Index).Text
                End If
                .Show vbModal
                If iFFAccion <> cFFAc_Cancelar Then
                    'aceptar el texto
                    If Index = cDescripcion Then
                        RichTextBox1.Text = .txtEditor.Text
                    Else
                        Text1(Index).Text = .txtEditor.Text
                    End If
                End If
            End With
            Unload fMiniEditor
            'restablecer el archivo de configuración actual
            sFFIni = sFicIni
        End Select
    End If
End Sub

Private Sub mnuRegBuscar_Click()
    cmdAccion_Click CMD_Buscar
End Sub

Private Sub mnuRegBuscarSig_Click()
    cmdAccion_Click CMD_BuscarSiguiente
End Sub

Private Sub mnuRegDatoAnterior_Click()
    'asignar al campo actual el dato anterior
    'sólo se "recuerdan" los datos guardados con el comando
    'actualizar del menú, barra herramientas o F9
    '
    'Se tiene en cuenta cuando se cambia el registro    (16/Sep/97)
    '
    If ControlActual = 0 Then Exit Sub
    If Len(Trim$(Campos(ControlActual).Anterior)) Then
        If ControlActual = cDescripcion Then
            RichTextBox1.Text = Campos(ControlActual).Anterior
        Else
            Text1(ControlActual).Text = Campos(ControlActual).Anterior
        End If
    End If
End Sub

Private Sub mnuRegImprimir_Click()
    'Imprimir sólo el campo descripción
    gsImprimir RichTextBox1
End Sub

Private Sub MostrarLinea(qControl As Control)
    Dim TotalLineas As Long
    Dim LineaActual As Long
    Const EM_GETLINECOUNT = &HBA
    Const EM_LINEFROMCHAR = &HC9
    
    TotalLineas = SendMessage(qControl.hWnd, EM_GETLINECOUNT, 0, 0&)
    LineaActual = SendMessage(qControl.hWnd, EM_LINEFROMCHAR, -1, 0&) + 1
    LblStatus(2) = "Lín:" & LineaActual & " de " & TotalLineas
End Sub

Private Sub mnuRegReemplazar_Click()
    cmdAccion_Click CMD_Reemplazar
End Sub

Private Sub mnuSalir_Click()
    Unload Me
    End
End Sub

Private Sub mnuSelecBase_Click()
    ' Cargar frmEntrada y cerrar este formualario                   (10/Nov/00)
    '
    gNoCargar = True                    ' Para no procesar la línea de comandos
    Unload Me                           ' Primero cerrar este formulario
    ' Desde frmEntrada se cargará de nuevo este formulario
    frmEntrada.Show
End Sub

Private Sub RichTextBox1_Click()
    LblStatus(0) = "(" & RichTextBox1.SelStart + 1 & "/" & RichTextBox1.MaxLength & ")"
    MostrarLinea RichTextBox1
End Sub

Private Sub RichTextBox1_DblClick()
    With fMiniEditor
        '.cmdImprimir.Enabled = False
        '.txtEditor.FontName = "Courier New"
        .txtEditor.Text = RichTextBox1.Text
        .Show vbModal
        If iFFAccion <> cFFAc_Cancelar Then
            'aceptar el texto
            RichTextBox1.Text = .txtEditor.Text
        End If
    End With
    Unload fMiniEditor
    'restablecer el archivo de configuración actual
    sFFIni = sFicIni
End Sub

Private Sub RichTextBox1_GotFocus()
    ControlActual = cDescripcion
End Sub

Private Sub RichTextBox1_KeyUp(KeyCode As Integer, Shift As Integer)
    LblStatus(0) = "(" & RichTextBox1.SelStart + 1 & "/" & RichTextBox1.MaxLength & ")"
    MostrarLinea RichTextBox1
End Sub

Private Sub RichTextBox1_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single)
    If Button = 2 Then
        PopupMenu mnuEd
    End If
End Sub

Private Sub RichTextBox1_OLEDragDrop(Data As RichTextLib.DataObject, Effect As Long, Button As Integer, Shift As Integer, x As Single, y As Single)
    '
    'Aceptar archivos dejados
    '
    Dim nFic As Integer
    Dim sNombre As String
    
    On Local Error Resume Next
    
    sNombre = Data.Files.Item(1)
    
    nFic = FreeFile
    Open sNombre For Input As nFic
    RichTextBox1.Text = Input$(LOF(nFic), nFic)
    Close nFic
    
    Err = 0
    On Local Error GoTo 0
    
End Sub

Private Sub Text1_Click(Index As Integer)
    LblStatus(0) = "(" & Text1(Index).SelStart + 1 & "/" & Text1(Index).MaxLength & ")"
    Select Case Index
    Case cAsunto ', cDescripcion
        MostrarLinea Text1(Index)
    Case Else
        LblStatus(2) = ""
    End Select
End Sub

Private Sub Text1_GotFocus(Index As Integer)
    'Esta variable se asignará cada vez que el control reciba el foco
    ControlActual = Index
    If Index = cDescripcion Then
        RichTextBox1.SetFocus
    End If
End Sub

Private Sub Text1_KeyPress(Index As Integer, KeyAscii As Integer)
    Dim sTmp As String
    
    ' Para los campos de fecha
    If Campos(Index).Tipo = adDate Then
        Select Case KeyAscii
        Case Asc("-"), Asc("."), Asc("/")
            KeyAscii = Asc(sSepFecha)
        Case vbKeyReturn
            Text1(Index) = AjustarFecha(Text1(Index))
        End Select
    End If
    If KeyAscii = vbKeyReturn Then
        KeyAscii = 0
        Select Case Index
        Case cDescripcion, cAsunto
            ' Nada, son campos multiline
        Case cFecha
            Text1(cFechaInicio).SetFocus
        Case cFechaInicio
            Text1(cFechaTermino).SetFocus
        Case cFechaTermino
            Check1.SetFocus
        Case Else
            SendKeys "{TAB}"
        End Select
    End If
End Sub

Private Sub Text1_KeyUp(Index As Integer, KeyCode As Integer, Shift As Integer)
    LblStatus(0) = "(" & Text1(Index).SelStart + 1 & "/" & Text1(Index).MaxLength & ")"
    Select Case Index
    Case cAsunto ', cDescripcion
        MostrarLinea Text1(Index)
    Case Else
        LblStatus(2) = ""
    End Select
End Sub

Private Sub Text2_GotFocus()
    
    SeleccionarTexto Text2
    ControlActual = 0
End Sub

Private Sub Text2_KeyPress(KeyAscii As Integer)
    Dim TxtID As Long

    On Local Error Resume Next

    If KeyAscii = 13 Then
        KeyAscii = 0
        If Not IsNull(Text2.Text) Then
            'Buscar ese ID.
            If Not YaEstoyAqui Then
                'Para poder modificar este campo...
                TxtID = Val(Text2.Text)
                'Data1.Find "c1ID = " & CStr(TxtID), 1
                Data1.Find "c1ID = " & CStr(TxtID), , adSearchForward, 1
                If Data1.EOF Then
                    Beep
                    Data1.MoveFirst
                End If
                '***Data1.Seek "=", TxtID
                Text2.Text = Data1!c1ID
            End If
        End If
    End If
End Sub

Private Sub Form_Load()
    Dim sTmp As String
    Dim i As Long
    '
    Check1.Value = vbUnchecked
    '
    LblStatus(2) = ""
    
    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
    
    LblStatus(0).Caption = ""
    ' Asignar la línea de estado
    Set LineaEstado = LblStatus(1)
    ' Asignar este form
    Set elForm = Me
    
    ' El tamaño por defecto
    iH = Height
    iW = Width
    
    ' Añadir el short-cut de Alt+F4 a la opción Salir:
    mnuSalir.Caption = "&Salir" & Chr$(9) & "Alt+F4"
    
    ' El archivo de configuración
    sFFIni = sFicIni
    ' le damos tiempo para que haga el Resize
    DoEvents
    
    sClasif = Trim$(gCD.LeerIni(sFicIni, "General", "Clasif_" & sUsuario, "c1ID"))
    If Len(sClasif) = 0 Then
        sClasif = "c1ID"
    End If
    
    ' Ahora podemos asignar el tamaño y posición que tenía antes:
    Dim tL&, tT&, tW&, tH&
    tL = Val(gCD.LeerIni(sFicIni, "Posición_" & sUsuario, "gsNotas_Left", CStr(Left)))
    tT = Val(gCD.LeerIni(sFicIni, "Posición_" & sUsuario, "gsNotas_Top", CStr(Top)))
    tW = Val(gCD.LeerIni(sFicIni, "Posición_" & sUsuario, "gsNotas_Width", CStr(Width)))
    tH = Val(gCD.LeerIni(sFicIni, "Posición_" & sUsuario, "gsNotas_Height", CStr(Height)))
    ' Asignamos el nuevo tamaño
    Move tL, tT, tW, tH
    '
    ' Si estaba maximizado...
    If Val(gCD.LeerIni(sFicIni, "Posición_" & sUsuario, "gsNotas_Maximizado", "0")) Then
        WindowState = vbMaximized
    End If
    '
    NumApartadosAnt = 1
    '
    NumApartados = Val(gCD.LeerIni(sFicIni, "Apartados_" & sUsuario, "Numero", "0"))
    If NumApartados < 1 Then
        With cboApartados
            .Clear
            '.AddItem "Mensajes"
            .AddItem "Notas"
            '.AddItem "Tips"
            .ListIndex = 0
            '
            NumApartados = 1
            gCD.GuardarIni sFicIni, "Apartados_" & sUsuario, "Numero", CStr(NumApartados)
            For i = 0 To NumApartados - 1
                gCD.GuardarIni sFicIni, "Apartados_" & sUsuario, "Nombre" & CStr(i), .List(i)
            Next
        End With
    Else
        LeerApartados
    End If
    
    Show
    DoEvents
    ' Cargar la tabla
    CargarTabla
    ' cargar el form de los bookmarks    (16/Sep/97)
    Load fBookmarks
    
    ' Mostrar Todos los mensajes
    cmdView_Click 0
    
    SeleccionarTexto Text1(1)
    DoEvents
End Sub

Private Sub SeleccionarTexto(unControl As Control)
    If TypeOf unControl Is TextBox Then
        With unControl
            If .MaxLength < 50 Then
                .SelStart = 0
                .SelLength = Len(.Text)
            End If
        End With
    End If
End Sub

Private Sub Form_Unload(Cancel As Integer)
    On Error Resume Next
    '
    ' Cerrar la base y destruir el objeto                ( 5/Jul/97)
    RsBuscar.Close
    Set RsBuscar = Nothing
    Data1.Close
    Set Data1 = Nothing
    'Db.Close
    'Set Db = Nothing
    Cnn.Close
    Set Cnn = Nothing
    
    ' Sólo si está mostrada de forma normal
    If WindowState = vbNormal Then
        gCD.GuardarIni sFicIni,