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.