|
|||||||
|
|
|
|||||
|
|
|||||||
|
|||||||
|
|
|
|||||
|
|
|||||||
1) Calcular el total de existencias (Precio * Stock) de un arreglo de Productos, que se
estructuran según sus propiedades básicas, de ubicación y de refrigeración.
SOLUCIÓN
Private Type ProductoBasico
codigo As Integer
nombre As String * 30
precio As Long
stock As Long
End Type
Private Type Ubicacion
bodega As Integer
estante As Integer
End Type
Private Type Estado
vencido As Boolean
temperatura As Single
End Type
Private Type Producto
p As ProductoBasico
u As Ubicacion
e As Estado
End Type
Const NUMPRODUCTOS = 3
Private Sub Form_Load()
Dim totalExistencias As Long, i As Integer
Dim arr(1 To NUMPRODUCTOS) As Producto
Dim mensaje As String
totalExistencias = 0
For i = 1 To NUMPRODUCTOS
arr(i).p.codigo = InputBox("Codigo")
arr(i).p.nombre = InputBox("Nombre")
arr(i).p.precio = InputBox("Precio")
arr(i).p.stock = InputBox("Stock")
With arr(i)
.u.bodega = InputBox("Bodega")
.u.estante = InputBox("Estante")
End With
With arr(i).e
.vencido = InputBox("Vencido? ... True/False")
.temperatura = InputBox("Temperatura")
End With
mensaje = "Producto Ingresado" & vbCrLf & vbCrLf
With arr(i)
With .p
mensaje = mensaje & _
"Codigo : " & Str(.codigo) & vbCrLf & _
"Nombre : " & .nombre & vbCrLf & _
"Precio : " & Str(.precio) & vbCrLf & _
"Stock : " & Str(.stock) & vbCrLf & vbCrLf
End With
With .u
mensaje = mensaje & _
"Bodega : " & Str(.bodega) & vbCrLf & _
"Estante : " & Str(.estante) & vbCrLf & vbCrLf
End With
With .e
mensaje = mensaje & _
"Vencido : " & Str(.vencido) & vbCrLf & _
"Temperatura : " & Str(.temperatura)
End With
End With
With arr(i).p
totalExistencias = totalExistencias + .precio * .stock
End With
MsgBox mensaje
Next i
MsgBox "Total Existencia : " & Str(totalExistencias)
End Sub
2) Generar aleatoriamente 3 vectores de tipo ((x,y,z),norma), para luego calcular la suma vectorial.
Deberá crear un arreglo de vectores de tamaño 3 para almacenar los vectores aleatorios y luego redimensionar
el arreglo para crear una cuarta posición.
SOLUCIÓN
Private Type Vector
x As Single
y As Single
z As Single
norma As Single
End Type
Const NumVectores = 3
Const PosicionVectorSuma = 4
Private Sub Form_Load()
ReDim arrVect(1 To NumVectores) As Vector
Dim i As Integer, mensaje As String
Randomize
mensaje = "Vectores generados aleatoriamente" & vbCrLf & vbCrLf
For i = 1 To NumVectores
'La funcion Rnd retorna un numero aleatorio mayor o igual a cero y menor que uno
' Por lo tanto Round(Rnd * 10,1) retorna un numero real mayor o igual a 0
' y menor que 10
With arrVect(i)
.x = Round(Rnd * 10, 2)
.y = Round(Rnd * 10, 2)
.z = Round(Rnd * 10, 2)
.norma = Sqr(.x * .x + .y * .y + .z * .z)
mensaje = mensaje & "Vector " & Str(i) & " : " & _
Str(.x) & ", " & Str(.y) & ", " & Str(.z) & vbCrLf & _
"Norma : " & Str(Round(.norma, 2)) & vbCrLf
End With
Next i
'redimensiona el arreglo conservando su contenido
ReDim Preserve arrVect(1 To PosicionVectorSuma)
For i = 1 To NumVectores
With arrVect(PosicionVectorSuma)
.x = .x + arrVect(i).x
.y = .y + arrVect(i).y
.z = .z + arrVect(i).z
End With
Next i
With arrVect(PosicionVectorSuma)
.norma = Sqr(.x * .x + .y * .y + .z * .z)
mensaje = mensaje & "Vector " & Str(i) & " : " & _
Str(.x) & ", " & Str(.y) & ", " & Str(.z) & vbCrLf & _
"Norma : " & Str(Round(.norma, 2))
End With
MsgBox mensaje
End Sub
3) Verificar si una matriz de tamaño NxN es mágica, o sea que la sumatoria de sus filas. columnas
y diagonales sean iguales.
SOLUCIÓN
Dim m() As Integer, suma() As Integer
Dim dimension As Integer
Dim f As Integer, c As Integer, pos As Integer
Dim i As Integer, MatrizMagica As Boolean
Dim mensaje As String
dimension = InputBox("Numero de filas")
'redimensionar la matriz y el arreglo de sumatorias
ReDim m(1 To dimension, 1 To dimension) As Integer
ReDim suma(1 To 2 * dimension + 2) As Integer
MatrizMagica = False
'asegurar que los valores del arreglo sean todos igual a cero
For i = 1 To dimension
suma(i) = 0
Next i
For f = 1 To dimension
For c = 1 To dimension
m(f, c) = InputBox("M( " & Str(f) & " , " & Str(c) & " ) : ")
Next c
Next f
'suma por fila
pos = 1
For f = 1 To dimension
For c = 1 To dimension
suma(pos) = suma(pos) + m(f, c)
Next c
pos = pos + 1
Next f
'suma por columna
For c = 1 To dimension
For f = 1 To dimension
suma(pos) = suma(pos) + m(f, c)
Next f
pos = pos + 1
Next c
'suma por diagonal principal sera almacenada en la posicion pos del arreglo suma
'deberan ser generadas las combinaciones (1,1),(2,2), ... (dimension , dimension).
For f = 1 To dimension
suma(pos) = suma(pos) + m(f, f)
Next f
' Para hacer el recorrido de la otra diagonal debemos generar las combinaciones :
'(dimension , 1)(dimension - 1 , 2) .. ( 2 , dimension - 1 )( 1 , dimension )
'para ver mejor si la matriz fuera de 3x3 la sumatoria seria :
's = m[3][1] + m[2][2] + m[1][3]
'donde hay un decremento de la fila y un incremento de la columna.
pos = pos + 1
c = 1
For f = dimension To 1 Step -1
suma(pos) = suma(pos) + m(f, c)
c = c + 1
Next f
' Ahora comparamos el primer elemento del arreglo suma, con los demas elementos
' para ver si todos son iguales.
' Para ello, vamos a suponer que la matriz es magica, usando una variable auxiliar
' de tipo boolean inicializada en true.
' Si durante el ciclo de recorrido del arreglo se encuentra una suma diferente,
' se asigna false a la variable y se procede a quebrar el ciclo For con la
' instruccion Exit for
MatrizMagica = True
For pos = 2 To dimension * 2 + 2
If (suma(pos) <> suma(1)) Then
MatrizMagica = False
Exit For
End If
Next pos
mensaje = "Matriz : " & vbCrLf & vbCrLf
For f = 1 To dimension
For c = 1 To dimension
mensaje = mensaje & Str(m(f, c)) & " "
Next c
mensaje = mensaje & vbCrLf
Next f
mensaje = mensaje & vbCrLf
If MatrizMagica Then
mensaje = mensaje & "ES MAGICA"
Else
mensaje = mensaje & "NO ES MAGICA"
End If
mensaje = mensaje & vbCrLf & vbCrLf
mensaje = mensaje & "Arreglo de sumas : "
For pos = 1 To dimension * 2 + 2
mensaje = mensaje & suma(pos)
If (pos <> dimension * 2 + 2) Then
mensaje = mensaje & ","
End If
Next pos
MsgBox mensaje
' ejemplos de cuadrados magicos 3x3
' 4 9 2 10 15 8
' A : 3 5 7 B : 9 11 13
' 8 1 6 14 7 12
' Sum(A) = 15 , Sum(B) = 33
4) Usar Archivos para almacenar las notas finales de N alumnos y calcular el promedio.
SOLUCIÓN
'definicion de la estructura de datos que tendra el archivo binario
Private Type Alumno
rut As String * 15
nombre As String * 30
notaFinal As Single
End Type
Private Sub Form_Load()
Dim i As Integer, PromNotas As Single, numIngreso As Integer
Dim aux As Alumno
Dim numRegs As Integer, posicion As Integer, numArchivo As Integer
numIngreso = InputBox("Cuantos alumnos desea registrar")
numRegs = 0
numArchivo = FreeFile
'apertura del archivo en modo binario
Open "bdAlumnos.bin" For Binary As #numArchivo Len = Len(aux)
'se determina el numero de registros
numRegs = LOF(numArchivo) \ Len(aux)
For i = 1 To numIngreso
posicion = numRegs * Len(aux) + 1
'se busca la posicion (1,50,100) en el archivo
' ... ya que Len(aux) = 49
Seek #numArchivo, posicion
With aux
.rut = InputBox("rut")
.nombre = InputBox("nombre")
.notaFinal = InputBox("nota final (ej : 5,6)")
End With
'se escribe la variable aux de tipo Alumno en el archivo
'en una posicion especifica
Put #numArchivo, posicion, aux
numRegs = numRegs + 1
Next i
Close #numArchivo
Open "bdAlumnos.bin" For Binary As #numArchivo Len = Len(aux)
numRegs = LOF(numArchivo) \ Len(aux)
posicion = 1
Debug.Print "---------"
PromNotas = 0
For i = 1 To numRegs
' se lee de una cierta posicion, y el contenido se almacena en aux
Get #numArchivo, posicion, aux
Debug.Print aux.nombre & " , " & Str(aux.notaFinal)
PromNotas = PromNotas + aux.notaFinal
posicion = posicion + Len(aux)
Next i
' se cierra el archivo
Close #numArchivo
MsgBox "Promedio de notas : " & Str(Round(PromNotas / numRegs, 2))
End Sub
5) Usar Archivos y arreglos, para generar aleatoriamente N triangulos espaciales y determinar el
mayor perímetro generado
SOLUCIÓN
Private Type Punto
x As Double
y As Double
z As Double
End Type
Private Type Recta
puntoInicial As Punto
puntoFinal As Punto
End Type
Private Type Triangulo
lado(1 To 3) As Recta
perimetro As Double
End Type
Private Sub Form_Load()
Dim i As Integer, numIngreso As Integer, k As Integer
Dim aux As Triangulo
Dim numRegs As Integer, posicion As Integer, numArchivo As Integer
Dim maxPerimetro As Double, mensaje As String
Dim ArrTrg() As Triangulo
numIngreso = InputBox("Cuantos triangulos aleatorios desea generar y almacenar en el archivo?")
numRegs = 0
numArchivo = FreeFile
'apertura del archivo en modo binario
Open "bdTriangulos.bin" For Binary As #numArchivo Len = Len(aux)
'se determina el numero de registros
numRegs = LOF(numArchivo) \ Len(aux)
Randomize
For i = 1 To numIngreso
posicion = numRegs * Len(aux) + 1
Seek #numArchivo, posicion
' se genera primera recta o lado
With aux.lado(1).puntoInicial
.x = Round(Rnd * 10, 2)
.y = Round(Rnd * 10, 2)
.z = Round(Rnd * 18, 2)
End With
With aux.lado(1).puntoFinal
.x = Round(Rnd * 8, 2)
.y = Round(Rnd * 14, 2)
.z = Round(Rnd * 7, 2)
End With
With aux
.lado(2).puntoInicial = .lado(1).puntoInicial
End With
With aux.lado(2).puntoFinal
.x = Round(Rnd * 14, 2)
.y = Round(Rnd * 9, 2)
.z = Round(Rnd * 13, 2)
End With
With aux.lado(3)
.puntoInicial = aux.lado(1).puntoFinal
.puntoFinal = aux.lado(2).puntoFinal
End With
aux.perimetro = CalculoPerimetro(aux)
Put #numArchivo, posicion, aux
numRegs = numRegs + 1
Next i
Close #numArchivo
Open "bdTriangulos.bin" For Binary As #numArchivo Len = Len(aux)
numRegs = LOF(numArchivo) \ Len(aux)
posicion = 1
ReDim ArrTrg(1 To numRegs)
For i = 1 To numRegs
' se lee de una cierta posicion, y el contenido se almacena en el arreglo
Get #numArchivo, posicion, ArrTrg(i)
posicion = posicion + Len(aux)
Next i
' se cierra el archivo
Close #numArchivo
maxPerimetro = ArrTrg(1).perimetro
posicion = 1 'ahora actua en el contexto del arreglo
' busca el maximo perimetro
For i = 1 To numRegs
With ArrTrg(i)
If (.perimetro > maxPerimetro) Then
maxPerimetro = .perimetro
posicion = i
End If
End With
Next i
aux = ArrTrg(posicion)
With aux
mensaje = "Se procesaron " & Str(numRegs) & " registros , de los cuales el triangulo" & vbCrLf & _
"con mayor perimetro " & "(" & Str(Round(.perimetro, 3)) & ") corresponde a : " & vbCrLf & vbCrLf & _
"PUNTO INICIAL" & vbTab & vbTab & "PUNTO FINAL" & vbCrLf
For i = 1 To 3
With .lado(i)
With .puntoInicial
mensaje = mensaje & Format(.x, "#.##") & " : " & Format(.y, "#.##") & " : " & Format(.z, "#.##") & vbTab & vbTab
End With
With .puntoFinal
mensaje = mensaje & Format(.x, "#.##") & " : " & Format(.y, "#.##") & " : " & Format(.z, "#.##")
End With
End With
mensaje = mensaje & vbCrLf
Next i
MsgBox mensaje
End With
End Sub
Private Function DifCuadr(ByVal a As Double, b As Double) As Double
DifCuadr = (b - a) * (b - a)
End Function
Private Function Distancia(ByRef r As Recta) As Double
Dim d As Double
With r
d = DifCuadr(.puntoFinal.x, .puntoInicial.x)
d = d + DifCuadr(.puntoFinal.y, .puntoInicial.y)
d = d + DifCuadr(r.puntoFinal.z, r.puntoInicial.z)
End With
Distancia = Sqr(d)
End Function
Private Function CalculoPerimetro(ByRef trg As Triangulo) As Double
Dim i As Integer, perim As Double
For i = 1 To 3
With trg
perim = perim + Distancia(.lado(i))
End With
Next i
CalculoPerimetro = perim
End Function
I) Usar Archivos y arreglos, para almacenar y procesar las notas de un curso.
Cada alumno rinde 4 controles de los cuales se elimina el que tenga la peor nota.
Cada alumno rinde tres solemnes de las cuales se elimina la peor nota.
Si la nota de presentacion es mayor o igual a 3.5 el alumno puede dar examen.
Nota de presentación : 35% solemne1 + 35% solemne2 + 30% promedio de controles
Nota final : 30% examen + 70% nota presentacion
Determinar : Listado y promedio de notas de alumnos aprobados, Listado y promedio de notas de alumnos reprobados
II) Usar archivos y arreglos, para generar en el plano (X,Y) rectángulos de longitud aleatoria, para luego determinar la máxima y mínima superficie.