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.
|
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)