Un Gran Proyecto, Paso a Paso

 

Tercera Entrega (7/Mar/97)

Pulsa aquí, para ver la Primera Entrega
Nota: Deberías verla, porque ha habido cambios
Pulsa aquí, para ver la
Segunda Entrega
Recomendable para poder seguir el hilo (que no thread)


En la entrega anterior, (si lo sé hoy no es el mañana al que me refería... pero recuerda que hubo quién dijo: ...como decíamos ayer... y habían pasado 7 u 8 años... así, que por cinco días...), te comentaba que no se hacíacomprobación de que la extensión fuese la adecuada. Vamos a trabajar con bases de Access, así que la extensión debe ser MDB, por tanto, vamos a añadir las siguientes líneas a la rutina cmdAceptar_Click() del formulario de Entrada, y las pones después del On Local Error... (Más abajo está el código completo de cmdAceptar)

If InStr(sUserBase, ".mdb") = 0 Then
    MsgBox "Atención la base especificada no tiene extensión MDB", vbInformation, cMsg
    'Posicionarse en el Text1
    Text1.SetFocus
    Exit Sub
End If

Ahora ya podemos seguir con la rutina de crear la base.

Private Sub CrearBase(sBase As String)
    'Crear la base de datos indicada
    '
    Dim Db As Database
    Dim Fd As Field
    Dim Tb As New TableDef      'Definir una Tabla
    Dim Idx As New Index        'Para crear un índice
    Dim i As Integer
    
    'Crear base de datos, idioma español y para la versión 2.0 del Jet de Access
    '================================================================================
    'Si vas a adaptar este programa para VB3, usa dbVersion11 en lugar de dbVersion20
    '================================================================================
    Set Db = CreateDatabase(sBase, dbLangSpanish, dbVersion20)
    '
    'La constante dbVersion20 no aparece en la ayuda, en su lugar lo hace la dbVersion25
    'pero ésa no está creada!!!
    '
    'Primero la tabla de las tareas
    Set Tb = Db.CreateTableDef("Tareas")
    'Vamos a crear cada uno de los campos
    Set Fd = Tb.CreateField("ID", dbLong)
    'Ahora vamos a asignar las propiedades de contador, etc.
    Fd.Attributes = dbAutoIncrField Or dbUpdatableField Or dbFixedField
    Tb.Fields.Append Fd
    'El resto de los campos
    Set Fd = Tb.CreateField("Fecha", dbDate)
    Tb.Fields.Append Fd
    Set Fd = Tb.CreateField("Asunto", dbText, 255)
    Tb.Fields.Append Fd
    Set Fd = Tb.CreateField("Descripcion", dbMemo)
    Tb.Fields.Append Fd
    Set Fd = Tb.CreateField("FechaInicio", dbDate)
    Tb.Fields.Append Fd
    Set Fd = Tb.CreateField("FechaTermino", dbDate)
    Tb.Fields.Append Fd
    Set Fd = Tb.CreateField("Terminada", dbInteger)
    Tb.Fields.Append Fd
    'Creamos un índice con el ID
    Idx.Name = "PrimaryKey"
    Idx.Unique = True
    Idx.Primary = True
    Idx.Fields = "ID"
    Tb.Indexes.Append Idx
    'Añadimos la tabla a la base
    Db.TableDefs.Append Tb
    '
    'Creamos la otra tabla: Anotaciones
    Set Tb = Db.CreateTableDef("Anotaciones")
    'El campo ID, es el contador, etc.
    Set Fd = Tb.CreateField("ID", dbLong)
    Fd.Attributes = dbAutoIncrField Or dbUpdatableField Or dbFixedField
    Tb.Fields.Append Fd
    'El resto de los campos
    Set Fd = Tb.CreateField("Fecha", dbDate)
    Tb.Fields.Append Fd
    Set Fd = Tb.CreateField("Tema", dbText, 50)
    Tb.Fields.Append Fd
    Set Fd = Tb.CreateField("Asunto", dbText, 255)
    Tb.Fields.Append Fd
    Set Fd = Tb.CreateField("Medio", dbText, 255)
    Tb.Fields.Append Fd
    Set Fd = Tb.CreateField("Localizacion", dbText, 255)
    Tb.Fields.Append Fd
    Set Fd = Tb.CreateField("Descripcion", dbMemo)
    Tb.Fields.Append Fd
    Set Fd = Tb.CreateField("Detalle", dbLongBinary)
    Tb.Fields.Append Fd
    'Creamos un índice con el ID
    Set Idx = Nothing           'Quitar la referencia anterior
    Idx.Name = "PrimaryKey"
    Idx.Unique = True
    Idx.Primary = True
    Idx.Fields = "ID"
    Tb.Indexes.Append Idx
    'Añadimos la segunda tabla a la base
    Db.TableDefs.Append Tb
    'Cerramos la base
    Db.Close
    
    MsgBox "Nueva base de datos " & sBase & " creada.", vbInformation
End Sub

Fijate en un detalle "¿sin importancia?". En la ayuda de VB, cuando muestra las constantes que podemos usar para la versión de la base de datos, aparece dbVersion25 y no está definida, en su lugar hay que usar dbVersion20, que si está definida como constante, pero no aparece en la lista de la ayuda.

Con esto ya está terminado el formulario de Entrada.
Aunque hay que realizar una serie de cambios en el cmdAceptar, aquí pongo de nuevo el código.
Además del cambio para comprobar la extensión, he añadido un nuevo chequeo, por si queremos crear una nueva base de datos a nuestro nombre. Esto se hace siempre que no sea el mismo nombre de la base y en el mismo directorio. (
Te recomiendo que uses este nuevo código)

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(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, cMsg
        Unload Me
        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$(LeerIni(ficIni, "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
        MsgBox "Atención la base especificada no tiene extensión MDB", vbInformation, cMsg
        'Posicionarse en el Text1
        Text1.SetFocus
        Exit Sub
    End If
        
    'Comprobar si existe "fisicamente" 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
        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
    GuardarIni ficIni, "General", sTmp, sUserPath
    GuardarIni ficIni, "General", "Usuario", sUsuario
    
    numBases = Combo1.ListCount
    GuardarIni ficIni, "General", "NumeroBases", CStr(numBases)
    'Guardar los nombres
    For i = 1 To numBases
        sTmp = "Base" & Format$(i, "00")
        sBase = Combo1.List(i - 1)
        GuardarIni ficIni, "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

Ahora tenemos que empezar con el form principal. Hay que crear una serie de campos/apartados para manejar o seleccionar la tabla con la que vamos a trabajar y todo eso.
Yo particularmente no uso el SSTab, (
no me gusta el aspecto que tiene), prefiero el control de Windows95, pero como sé que hay algunos por ahí que usan todavía el Windows 3.1, me lo pensaré...
Eso será más adelante, ahora vamos "a complicarnos la vida". ¿Cómo? Pues creando dos forms uno para las Tareas y otro para las Anotaciones.

Realmente no es para complicarnos la vida, es para no complicarmela yo demasiado.

Me explico: El proyecto irá avanzando y teniendo más cosillas, pero poco a poco; si tienes que esperar a que esté todo acabado... en fin. Aunque lo estoy "diseñando" todo lo "modular" que puedo, para intentar que cada "módulo" sea lo más independiente posible... al final se podrían complicar demasiado las cosas y no quiero que eso ocurra. Por tanto, sólo voy a incluir el código necesario para crear y usar la tabla de Tareas. El resto del programa, vendrá más adelante y usaremos las dos tablas en conjunto, a lo mejor hasta DbGrids y DbList y todas esas cosas que empiezan por DBxxx que tanto os gustan. (y que yo no uso nunca!)

Vamos al tajo, es decir a currar. (un momento que voy a comprobar cuán largo es este fichero..., vuelvo, ...es aceptable, así que seguiremos un poco más en este...)

Pensemos que es lo que vamos a necesitar:
Un DataControl, 7 etiquetas y 7 TextBox (una para cada campo de la tabla) y algún que otro botón, etc.
¿Dónde los colocamos? Por ahora usaremos el form principal es decir gsNotas.frm
Vamos a ver el aspecto que tendrá y un poco de explicación de los controles.

La línea de botones desde Nuevo a Pegar son cmdAccion(x) y los índices de 0-Nuevo hasta 2-Borrar
El botón Salir sigue igual, pero hay que incluirlo en el Picture1, que tiene la propiedad Align Top, sin bordes, Flat y con fondo gris claro.
Las etiquetas: Label1(x) y los índices desde el 0-Fecha a 5-Fecha Término.
Las cajas de Texto: Text1(x)
Asunto (2) y Descripción (3) son Multiline.
Terminado es: Check1

 

Ahora hay que añadir lo siguiente, para poder empezar a usar la base de datos que se supone habremos creado antes de entrar en el "form" principal.

'---------------------------------------------------------------
'Form para la entrada de datos de las Tareas        ( 7/Mar/97)
'
'Primera tentativa: 7/Mar/97
'
'código de ejemplo realizado por Guillermo Som
'---------------------------------------------------------------
Option Explicit

Dim YaEstoyAqui As Boolean          'Para el Text2
'constantes para los botones de acción
Const CMD_NUEVO = 0
Const CMD_ACTUALIZAR = 1
Const CMD_BORRAR = 2
'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


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


Private Sub cmdAccion_Click(Index As Integer)

    If Index = CMD_NUEVO Then           'Nuevo registro
        YaEstoyAqui = True
        Data1.Recordset.AddNew
        Data1.Enabled = False
        YaEstoyAqui = False
        Text1(1).SetFocus
    ElseIf Index = CMD_ACTUALIZAR Then
        'Guardar el contenido de cada uno de los campos
        If Data1.EditMode = EM_ADDNEW Then
            Data1.Recordset.Update
        Else
            Data1.Recordset.Edit
            Data1.Recordset.Update
            If Data1.EditMode = 0 Then
                '
            Else
                Data1.UpdateControls
            End If
        End If
        Data1.Enabled = True
        Data1.Refresh
        Data1.Recordset.MoveLast
        Text1(1).SetFocus
    ElseIf Index = CMD_BORRAR Then      'Borrar registro
        If MsgBox("¿Seguro que quieres borrar este registro?", 4 + 32 + 256) = 6 Then
            Data1.Recordset.Delete
            Data1.Refresh
            If Not Data1.Recordset.EOF Then
                Data1.Recordset.MoveLast
            Else
                Data1.Caption = "No hay registros"
            End If
        End If
    End If
End Sub


Private Sub cmdSalir_Click()
    Unload Me
    End
End Sub


Private Sub Data1_Reposition()
    Dim sTmp As String
    
    On Local Error Resume Next

    If Not Data1.Recordset.EOF Then
        'Esta rutina se ejecuta cuando un registro es el
        'registro actual, (cada vez que se actualiza)
        If Not IsNull(Data1.Recordset!ID) Then _
            sTmp = Data1.Recordset!ID
        
        If Not IsNull(Data1.Recordset!Fecha) Then _
            sTmp = sTmp & ", " & Data1.Recordset!Fecha
            
        If Not IsNull(Data1.Recordset!Asunto) Then _
            sTmp = sTmp & ", " & Data1.Recordset!Asunto
            
        If Len(sTmp) Then
            Data1.Caption = sTmp
        Else
            Data1.Caption = " Registro en blanco."
        End If
        If Not YaEstoyAqui Then
            If Not IsNull(Data1.Recordset!ID) Then
                Text2.Text = Data1.Recordset!ID
                YaEstoyAqui = True
                If Val(Data1.Recordset.Terminada) Then
                    Check1.Value = 1
                Else
                    Check1.Value = 0
                End If
                YaEstoyAqui = False
            End If
        End If
    Else
        Data1.Caption = "No hay registros."
        Text2.Text = Null
    End If
    Err = 0
    On Local Error GoTo 0
End Sub


Private Sub Form_Load()
    Show
    'Cargar la tabla
    CargarTabla
End Sub


Private Sub Form_Unload(Cancel As Integer)
    Set gsNotas = Nothing
End Sub


Private Sub Text2_GotFocus()
    Text2.SelStart = 0
    Text2.SelLength = Len(Text2.Text)
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.Recordset.FindFirst "ID = " & CStr(TxtID)
                Text2.Text = Data1.Recordset!ID
            End If
        End If
    End If
End Sub

Con esto ya se pueden empezar a crear registros y todas esas cosas, en las siguientes entregas veremos más cosas... ¿el qué? Algo se me ocurrirá... Es que, aunque se recomiende lo contrario, no suelo "planificar" apriori lo que haré, así que tendrás que ir "actualizando" el archivo ZIP con los listados, porque seguro que en lo que ya he codificado antes, habrán cambios...
Por ejemplo tendrás que añadir lo siguiente a las declaraciones del form de Entrada:

Option Compare Text

Porque si no lo haces, al hacer la comparación de la extensión, si se escribe distinto de minúsculas, no "lo encontrará".
Que los disfrutes.

Esto es todo por ahora.
Mañana más, (
bueno... el próximo día más).


Pulsa aquí si quieres bajar los listados de ejemplo y los archivos HTML (gsnotas.zip 37.8 KB)
(Este tamaño variará, según el número de entregas; para saber el tamaño actual, deberías ver la última entrega)