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)