Curso Básico de Programación
en Visual Basic
Soluciones
de la entrega Diecinueve.
Fecha: 25/Jun/98
Ahora sí que está la solución de la entrega 19, la verdad es que si no lo has conseguido, no debes preocuparte demasiado, no era tan "simple" como podría parecer, ya que se necesita de un poco de "tablas" y manejo en esto de la programación, así que si estás dispuesto a ser sincero, por favor envíame un mensaje diciendo si lo conseguiste o no, esto me ayudará a saber si tengo que poner cosas más sencillas o dedicarme a enseñar otras cosillas, no sé..., por ejemplo porqué cuando todo está oscuro no se ve nada... je.
Para volver a la entrega 19, pulsa en este link.
Este es el listado completo de la solución que YO he encontrado al ejercicio, por supuesto no tiene porqué ser igual a la tuya, si quieres puedes mandarme una copia del resultado que has encontrado... no te garantizo nada, pero lo mismo hasta te comento sobre él... Venga, ¡ánimo! que lo difícil aún no ha empezado... ;-)
Esta es una foto del programa en ejecución y el listado del mismo:
'------------------------------------------------------------------ 'Ejercicio para la entrega 19 (24/Jun/98) '(solución) ' '©Guillermo 'guille' Som, 1998 '------------------------------------------------------------------ Option Explicit Private Sub Form_Load() Dim i As Integer 'Para probar uso el fichero de colegas.dat 'el tamaño de cada campo era: 30, 2, 50 'Private Type t_Colega ' Nombre As String * 30 ' Edad As Integer ' email As String * 50 'End Type ' txtOrigen = "colegas.dat" 'Crear los controles de destino '(empezamos por UNO porque el control CERO ya está creado) For i = 1 To 9 'Cargarlos en memoria Load lblDest(i) Load txtDestTam(i) 'Asignarles la posición y hacerlos visible With txtDestTam(i) .Visible = True .Top = txtDestTam(i - 1).Top + .Height + 45 lblDest(i).Top = .Top - 15 lblDest(i).Visible = True lblDest(i) = "Campo " & i + 1 & ":" 'Ajustar el TabIndex, '(se supone que ya estaban por orden) lblDest(i).TabIndex = txtDestTam(i - 1).TabIndex + 1 .TabIndex = lblDest(i).TabIndex + 1 End With Next 'Borrar el contenido de los TextBoxes For i = 0 To 9 txtTam(i).Text = "" txtDestTam(i).Text = "" Next End Sub Private Sub cmdConvertir_Click() 'Variables para los nombres y números de ficheros Dim nFic As Long, nFic2 As Long Dim sFic As String, sFic2 As String 'Estos arrays controlarán los tamaños de cada campo Dim aOrigen() As Long Dim aDestino() As Long 'Número de campos en cada fichero Dim nOrigen As Integer Dim nDestino As Integer 'Tamaños de los registros Dim tOrigen As Integer Dim tDestino As Integer 'Las cadenas que contendrán los datos Dim sOrigen As String Dim sDestino As String 'Número de registros del fichero de origen Dim numReg As Integer Dim tamFic As Long 'Para usos generales Dim i As Long, j As Long Dim posReg As Long Dim sTmp As String 'Antes de hacer nada, comprobamos que exista el fichero 'de origen sFic = Trim$(txtOrigen) If Len(Dir$(sFic)) = 0 Then MsgBox "¡ATENCIÓN! No existe el fichero de origen." txtOrigen.SetFocus Exit Sub End If 'Asignamos el nombre del fichero de destino sFic2 = Trim$(txtDestino) 'Se asignarán los tamaños de cada registro, se dejará 'de comprobar cuando el contenido del textbox sea cero. 'Si se usara un TextBox con el número de campos, la cosa 'sería más fácil de controlar, pero... ' 'Empezamos por el origen For i = 0 To 9 If Val(txtTam(i)) = 0 Then 'ya no hay nada más que comprobar Exit For Else nOrigen = nOrigen + 1 ReDim Preserve aOrigen(nOrigen) 'asignamos el tamaño del campo nOrigen aOrigen(nOrigen) = Val(txtTam(i)) 'ajustamos el tamaño total del registro tOrigen = tOrigen + aOrigen(nOrigen) End If Next 'Ahora comprobamos el destino For i = 0 To 9 If Val(txtDestTam(i)) = 0 Then 'ya no hay nada más que comprobar Exit For Else nDestino = nDestino + 1 ReDim Preserve aDestino(nDestino) 'asignamos el tamaño del campo nDestino aDestino(nDestino) = Val(txtDestTam(i)) 'ajustamos el tamaño total del registro tDestino = tDestino + aDestino(nDestino) End If Next ' 'Ya tenemos la información suficiente, ' 'Por si da error al acceder a los ficheros On Local Error GoTo ErrorConvertir 'Abrimos los ficheros en modo binario nFic = FreeFile Open sFic For Binary As nFic 'Averiguar el número de registros de este fichero tamFic = LOF(nFic) numReg = tamFic \ tOrigen 'Comprobar que el tamaño especificado concuerda con el fichero 'Si el número de registros multiplicado por el tamaño de cada 'registro es diferente al tamaño del fichero... If numReg * tOrigen <> tamFic Then MsgBox "Los tamaños especificados en los campos de origen" & vbCrLf & _ "no concuerdan con el tamaño del fichero.", vbCritical, "Convertir ficheros" Close txtTam(0).SetFocus Exit Sub End If 'Abrimos el fichero de destino nFic2 = FreeFile Open sFic2 For Binary As nFic2 ' 'Preparamos la cadena que contendrá los datos de origen 'esta no cambiará de tamaño sOrigen = Space$(tOrigen) 'Hacemos un bucle para todos los registros de origen For j = 1 To numReg Get nFic, , sOrigen 'La cadena de destino se formará con el tamaño de 'los campos de origen más el tamaño de los nuevos campos, 'si el número de campos de destino es diferente, 'simplemente se rellenará la cadena con espacios sDestino = "" ' 'Esta variable contendrá la posición dentro del registro 'del campo que se esté procesando posReg = 1 For i = 1 To nOrigen 'Tomamos el contenido del campo actual sTmp = Mid$(sOrigen, posReg, aOrigen(i)) 'Asignamos este campo y lo rellenamos de espacios sTmp = Left$(sTmp & Space$(aDestino(i)), aDestino(i)) sDestino = sDestino & sTmp 'ajustamos el tamaño de la posición dentro del registro 'de origen posReg = posReg + aOrigen(i) Next 'Ahora hay que rellenar la cadena de destino con espacios 'suficientes hasta completar el número de caracteres 'que se han especificado. ' 'El TRUCO está en añadirle a la cadena de destino la 'cantidad de caracteres totales y sólo quedarnos 'con esa cantidad, de esta forma nos aseguramos que 'tendremos la cantidad que necesitamos tener... ' sDestino = Left$(sDestino & Space$(tDestino), tDestino) 'Lo guardamos Put nFic2, , sDestino Next 'Se acabó de convertir, cerramos los ficheros Close 'Guardamos la información de los formatos usados: ' 'Uso un formato standard INI para que se pueda leer de forma 'fácil, incluso usando el ejemplo de la entrega 20 ' nFic = FreeFile Open "Convertir.ini" For Output As nFic 'Datos de origen: Print #nFic, "[Datos de Origen]" Print #nFic, "Fichero=" & sFic Print #nFic, "Número de campos=" & nOrigen For i = 1 To nOrigen Print #nFic, "Tamaño Campo" & CStr(i) & "=" & aOrigen(i) Next Print #nFic, "" 'Datos de destino: Print #nFic, "[Datos de Destino]" Print #nFic, "Fichero=" & sFic2 Print #nFic, "Número de campos=" & nDestino For i = 1 To nDestino Print #nFic, "Tamaño Campo" & CStr(i) & "=" & aDestino(i) Next Close 'Avisamos de que todo acabó bien MsgBox "Se ha convertido el fichero de forma satisfactoria," & vbCrLf & _ "La información de los datos convertidos está en: Convertir.ini", _ vbInformation, "Convertir ficheros." SalirConvertir: Close Exit Sub ErrorConvertir: MsgBox "Se ha producido el siguiente error:" & vbCrLf & _ Err.Number & " " & Err.Description, vbCritical, "Convertir ficheros" Resume SalirConvertir End SubEl contenido del fichero "Convertir.ini" de la prueba que he hecho, sería el siguiente:
[Datos de Origen] Fichero=colegas.dat Número de campos=3 Tamaño Campo1=30 Tamaño Campo2=2 Tamaño Campo3=50 [Datos de Destino] Fichero=colegas2.dat Número de campos=4 Tamaño Campo1=40 Tamaño Campo2=2 Tamaño Campo3=50 Tamaño Campo4=128Nos vemos.
GuillermoSi quieres los listados del programilla, para verlo más cómodamente, los puedes bajar pulsando en este link.