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)