Convertidor de medidas

Presentación:

Hola me llamo Marcos (alias: El Maestro del Desastre) y ésta es mi primera colaboración. Bueno basta de presentaciones y paso a explicarte de que se trata este programilla: 

¿De qué se trata?

Bien, esta aplicación te permite convertir medidas. Por ejemplo: de kilómetros a millas, etc. No soy un experto, así que no te quejes de que el código es largo (supongo que habrá una forma más corta de hacerlo pero todavía no poseo los conocimientos necesarios como para lograrlo :< ). Para compensar esto puse todo bien explicado; tanto, que hasta un mono lo entendería (si, yo también). Podría haber usado menos variables pero me resultó más fácil poner una variable por cada medida. Si no te gusta, lo lamento; y si querés matarme por usar tantas variables vas a tener que venir hasta Argentina, jajaja. ^_^

El código:

'------------------------------'
'Convertidor de medidas v1.00  '
'(2005) El Maestro del Desastre'
'------------------------------'
Option Explicit
Dim LON(0 To 7) As Double   'Variable de longitud
Dim VOL(0 To 5) As Double   'Variable de volúmen
Dim AREA(0 To 5) As Double  'Variable de área
Dim MASA(0 To 3) As Double  'Variable de masa
Dim TEMP(0 To 1) As Double  'Variable de temperatura
Dim LONGITUD(0 To 7) As Boolean 'Bandera de longitud
Dim VOLUMEN(0 To 5) As Boolean  'Bandera de volúmen
Dim AR(0 To 5) As Boolean       'Bandera de área
Dim MAS(0 To 3) As Boolean      'Bandera de masa
Dim TEM(0 To 1) As Boolean      'Bandera de temperatura
Const CEL = -17.777777 'Constante de celsius
Const FAH = 32         'Constante de fahrenheit

Private Sub cmdAcerca_Click()
frmAcDeConvMed.Show
End Sub

Private Sub cmdBorrar_Click()
Dim tLong As Integer
Dim tArea As Integer
Dim tVol As Integer
Dim tMasa As Integer
Dim tTemp As Integer

'Bucles para borrar el contenido de todos los TextBox
For tLong = 0 To 7
    txtLong(tLong) = "" 'Contenido Longitud
Next

For tVol = 0 To 5
    txtVol(tVol) = ""   'Contenido Volúmen
Next

For tArea = 0 To 5
    txtArea(tArea) = "" 'Contenido Área
Next

For tMasa = 0 To 3
    txtMasa(tMasa) = "" 'Contenido Masa
Next

For tTemp = 0 To 1
    txtTemp(tTemp) = "" 'Contenido Temperatura
Next

End Sub

Private Sub cmdSalir_Click()
End 'Finalizar la aplicación
End Sub

Private Sub txtArea_Change(Index As Integer)
On Local Error Resume Next
Error = 0

Select Case Index
    
    Case 0 'centímetros C.
    If AR(0) = True Then
        AREA(0) = CDbl(txtArea(0))
        txtArea(1) = AREA(0) * 0.0001     'metros C.
        txtArea(2) = AREA(0) * 0.1550003  'pulgadas C.
        txtArea(3) = AREA(0) * 0.00107639 'pies C.
        txtArea(4) = AREA(0) * 0.00000002 'acres
        txtArea(5) = AREA(0) * 0.00000001 'hectáreas
    End If

    Case 1 'metros C.
    If AR(1) = True Then
        AREA(1) = CDbl(txtArea(1))
        txtArea(0) = AREA(1) * 10000      'centímetros C.
        txtArea(2) = AREA(1) * 1550.00304 'pulgadas C.
        txtArea(3) = AREA(1) * 10.76391   'pies C.
        txtArea(4) = AREA(1) * 0.00024711 'acres
        txtArea(5) = AREA(1) * 0.0001     'hectáreas
    End If

    Case 2 'pulgadas C.
    If AR(2) = True Then
        AREA(2) = CDbl(txtArea(2))
        txtArea(0) = AREA(2) * 6.4516     'centímetros C.
        txtArea(1) = AREA(2) * 0.00064516 'metros C.
        txtArea(3) = AREA(2) * 0.00694444 'pies C.
        txtArea(4) = AREA(2) * 0.00000016 'acres
        txtArea(5) = AREA(2) * 0.00000006 'hectáreas
    End If

    Case 3 'pies C.
    If AR(3) = True Then
        AREA(3) = CDbl(txtArea(3))
        txtArea(0) = AREA(3) * 929.0304   'centímetros C.
        txtArea(1) = AREA(3) * 0.09290304 'metros C.
        txtArea(2) = AREA(3) * 144        'pulgadas C.
        txtArea(4) = AREA(3) * 0.00002296 'acres
        txtArea(5) = AREA(3) * 0.00000929 'hectáreas
    End If

    Case 4 'acres
    If AR(4) = True Then
        AREA(4) = CDbl(txtArea(4))
        txtArea(0) = AREA(4) * 40468564   'centímetros C.
        txtArea(1) = AREA(4) * 4046.8564  'metros C.
        txtArea(2) = AREA(4) * 6272640    'pulgadas C.
        txtArea(3) = AREA(4) * 43560      'pies C.
        txtArea(5) = AREA(4) * 0.40468564 'hectáreas
    End If

    Case 5 'hectáreas
    If AR(5) = True Then
        AREA(5) = CDbl(txtArea(5))
        txtArea(0) = AREA(5) * 100000000  'centímetros C.
        txtArea(1) = AREA(5) * 10000      'metros C.
        txtArea(2) = AREA(5) * 15500032.1 'pulgadas C.
        txtArea(3) = AREA(5) * 107639.112 'pies C.
        txtArea(4) = AREA(5) * 2.471054   'acres
    End If

End Select
End Sub

Private Sub txtArea_GotFocus(Index As Integer)
Select Case Index

    Case 0
    AR(0) = True 'Conecta la bandera de centímetros C.
    
    Case 1
    AR(1) = True 'Conecta la bandera de metros C.
    
    Case 2
    AR(2) = True 'Conecta la bandera de pulgadas C.
    
    Case 3
    AR(3) = True 'Conecta la bandera de pies C.
    
    Case 4
    AR(4) = True 'Conecta la bandera de acres
    
    Case 5
    AR(5) = True 'Conecta la bandera de hectáreas
    
End Select
End Sub

Private Sub txtArea_LostFocus(Index As Integer)
Select Case Index

    Case 0
    AR(0) = False 'Desconecta la bandera de centímetros C.
    
    Case 1
    AR(1) = False 'Desconecta la bandera de metros C.
    
    Case 2
    AR(2) = False 'Desconecta la bandera de pulgadas C.
    
    Case 3
    AR(3) = False 'Desconecta la bandera de pies C.
    
    Case 4
    AR(4) = False 'Desconecta la bandera de acres
    
    Case 5
    AR(5) = False 'Desconecta la bandera de hectáreas
    
End Select
End Sub

Private Sub txtMasa_Change(Index As Integer)
On Local Error Resume Next
Error = 0

Select Case Index

    Case 0 'gramos
    If MAS(0) = True Then
        MASA(0) = CDbl(txtMasa(0))
        txtMasa(1) = MASA(0) * 0.001      'kilogramos
        txtMasa(2) = MASA(0) * 0.03527396 'onzas
        txtMasa(3) = MASA(0) * 0.00220462 'libras
    End If

    Case 1 'kilogramos
    If MAS(1) = True Then
        MASA(1) = CDbl(txtMasa(1))
        txtMasa(0) = MASA(1) * 1000       'gramos
        txtMasa(2) = MASA(1) * 35.2739616 'onzas
        txtMasa(3) = MASA(1) * 2.2046226  'libras
    End If

    Case 2 'onzas
    If MAS(2) = True Then
        MASA(2) = CDbl(txtMasa(2))
        txtMasa(0) = MASA(2) * 28.349523  'gramos
        txtMasa(1) = MASA(2) * 0.02834952 'kilogramos
        txtMasa(3) = MASA(2) * 0.0625     'libras
    End If

    Case 3 'libras
    If MAS(3) = True Then
        MASA(3) = CDbl(txtMasa(3))
        txtMasa(0) = MASA(3) * 453.59237  'gramos
        txtMasa(1) = MASA(3) * 0.45359237 'kilogramos
        txtMasa(2) = MASA(3) * 16         'onzas
    End If

End Select
End Sub

Private Sub txtMasa_GotFocus(Index As Integer)
Select Case Index

    Case 0
    MAS(0) = True 'Conecta la bandera de gramos
    
    Case 1
    MAS(1) = True 'Conecta la bandera de kilogramos
    
    Case 2
    MAS(2) = True 'Conecta la bandera de onzas
    
    Case 3
    MAS(3) = True 'Conecta la bandera de libras
    
End Select
End Sub

Private Sub txtMasa_LostFocus(Index As Integer)
Select Case Index

    Case 0
    MAS(0) = False 'Desconecta la bandera de gramos
    
    Case 1
    MAS(1) = False 'Desconecta la bandera de kilogramos
    
    Case 2
    MAS(2) = False 'Desconecta la bandera de onzas
    
    Case 3
    MAS(3) = False 'Desconecta la bandera de libras
    
End Select
End Sub

Private Sub txtTemp_Change(Index As Integer)
On Local Error Resume Next
Error = 0

Select Case Index
    
    Case 0 'celsius
    If TEM(0) = True Then
        TEMP(0) = CDbl(txtTemp(0))
        txtTemp(1) = FAH + (TEMP(0) * 1.8) 'fahrenheit
    End If
    
    Case 1 'fahrenheit
    If TEM(1) = True Then
        TEMP(1) = CDbl(txtTemp(1))
        txtTemp(0) = CEL + (TEMP(1) * 0.555555) 'celsius
    End If
    
End Select
End Sub

Private Sub txtTemp_GotFocus(Index As Integer)
Select Case Index

    Case 0
    TEM(0) = True 'Conecta la bandera de celsius
    
    Case 1
    TEM(1) = True 'Conecta la bandera de fahrenheit
    
End Select
End Sub

Private Sub txtTemp_LostFocus(Index As Integer)
Select Case Index

    Case 0
    TEM(0) = False 'Desconecta la bandera de celsius
    
    Case 1
    TEM(1) = False 'Desconecta la bandera de fahrenheit
    
End Select
End Sub

Private Sub txtVol_Change(Index As Integer)
On Local Error Resume Next
Error = 0

Select Case Index

    Case 0 'mililitros
    If VOLUMEN(0) = True Then
        VOL(0) = CDbl(txtVol(0))
        txtVol(1) = VOL(0) * 0.001      'litros
        txtVol(2) = VOL(0) * 0.0675675  'cucharadas
        txtVol(3) = VOL(0) * 0.00211148 'pintas
        txtVol(4) = VOL(0) * 0.00105574 'cuartos galón
        txtVol(5) = VOL(0) * 0.00026394 'galón
    End If

    Case 1 'litros
    If VOLUMEN(1) = True Then
        VOL(1) = CDbl(txtVol(1))
        txtVol(0) = VOL(1) * 1000       'mililitros
        txtVol(2) = VOL(1) * 33.8140224 'cucharadas
        txtVol(3) = VOL(1) * 2.1133764  'pintas
        txtVol(4) = VOL(1) * 1.0566882  'cuartos galón
        txtVol(5) = VOL(1) * 0.26417205 'galón
    End If

    Case 2 'cucharadas
    If VOLUMEN(2) = True Then
        VOL(2) = CDbl(txtVol(2))
        txtVol(0) = VOL(2) * 14.79      'mililitros
        txtVol(1) = VOL(2) * 0.01479    'litros
        txtVol(3) = VOL(2) * 0.03125    'pintas
        txtVol(4) = VOL(2) * 0.015625   'cuartos galón
        txtVol(5) = VOL(2) * 0.00390625 'galón
    End If

    Case 3 'pintas
    If VOLUMEN(3) = True Then
        VOL(3) = CDbl(txtVol(3))
        txtVol(0) = VOL(3) * 473.1765  'mililitros
        txtVol(1) = VOL(3) * 0.4731765 'litros
        txtVol(2) = VOL(3) * 32        'cucharadas
        txtVol(4) = VOL(3) * 0.5       'cuartos galón
        txtVol(5) = VOL(3) * 0.125     'galón
    End If

    Case 4 'cuartos galón
    If VOLUMEN(4) = True Then
        VOL(4) = CDbl(txtVol(4))
        txtVol(0) = VOL(4) * 946.353  'mililitros
        txtVol(1) = VOL(4) * 0.946353 'litros
        txtVol(2) = VOL(4) * 64       'cucharadas
        txtVol(3) = VOL(4) * 2        'pintas
        txtVol(5) = VOL(4) * 0.25     'galón
    End If

    Case 5 'galón
    If VOLUMEN(5) = True Then
        VOL(5) = CDbl(txtVol(5))
        txtVol(0) = VOL(5) * 3785.412 'mililitros
        txtVol(1) = VOL(5) * 3.785412 'litros
        txtVol(2) = VOL(5) * 256      'cucharadas
        txtVol(3) = VOL(5) * 8        'pintas
        txtVol(4) = VOL(5) * 4        'cuartos galón
    End If

End Select
End Sub

Private Sub txtVol_GotFocus(Index As Integer)
Select Case Index
    
    Case 0
    VOLUMEN(0) = True 'Conecta la bandera de mililitros

    Case 1
    VOLUMEN(1) = True 'Conecta la bandera de litros
    
    Case 2
    VOLUMEN(2) = True 'Conecta la bandera de cucharadas

    Case 3
    VOLUMEN(3) = True 'Conecta la bandera de pintas

    Case 4
    VOLUMEN(4) = True 'Conecta la bandera de cuartos galón

    Case 5
    VOLUMEN(5) = True 'Conecta la bandera de galón

End Select
End Sub

Private Sub txtVol_LostFocus(Index As Integer)
Select Case Index
    
    Case 0
    VOLUMEN(0) = False 'Desconecta la bandera de mililitros

    Case 1
    VOLUMEN(1) = False 'Desconecta la bandera de litros
    
    Case 2
    VOLUMEN(2) = False 'Desconecta la bandera de cucharadas

    Case 3
    VOLUMEN(3) = False 'Desconecta la bandera de pintas

    Case 4
    VOLUMEN(4) = False 'Desconecta la bandera de cuartos galón

    Case 5
    VOLUMEN(5) = False 'Desconecta la bandera de galón

End Select
End Sub

Private Sub txtLong_Change(Index As Integer)
On Local Error Resume Next
Error = 0

Select Case Index

    Case 0 'milímetros
    If LONGITUD(0) = True Then
        LON(0) = CDbl(txtLong(0))
        txtLong(1) = LON(0) * 0.1       'centímetros
        txtLong(2) = LON(0) * 0.001     'metros
        txtLong(3) = LON(0) * 0.000001  'kilómetros
        txtLong(4) = LON(0) * 0.0393701 'pulgadas
        txtLong(5) = LON(0) * 0.0032808 'pies
        txtLong(6) = LON(0) * 0.0010936 'yardas
        txtLong(7) = LON(0) * 0.0000006 'millas
    End If
    
    Case 1 'centímetros
    If LONGITUD(1) = True Then
        LON(1) = CDbl(txtLong(1))
        txtLong(0) = LON(1) * 10        'milímetros
        txtLong(2) = LON(1) * 0.01      'metros
        txtLong(3) = LON(1) * 0.00001   'kilómetros
        txtLong(4) = LON(1) * 0.3937008 'pulgadas
        txtLong(5) = LON(1) * 0.0328084 'pies
        txtLong(6) = LON(1) * 0.0109361 'yardas
        txtLong(7) = LON(1) * 0.0000062 'millas
    End If
    
    Case 2 'metros
    If LONGITUD(2) = True Then
        LON(2) = CDbl(txtLong(2))
        txtLong(0) = LON(2) * 1000       'milímetros
        txtLong(1) = LON(2) * 100        'centímetros
        txtLong(3) = LON(2) * 0.001      'kilómetros
        txtLong(4) = LON(2) * 39.3700788 'pulgadas
        txtLong(5) = LON(2) * 3.2808399  'pies
        txtLong(6) = LON(2) * 1.0936133  'yardas
        txtLong(7) = LON(2) * 0.0006214  'millas
    End If
    
    Case 3 'kilómetros
    If LONGITUD(3) = True Then
        LON(3) = CDbl(txtLong(3))
        txtLong(0) = LON(3) * 1000000    'milímetros
        txtLong(1) = LON(3) * 100000     'centímetros
        txtLong(2) = LON(3) * 1000       'metros
        txtLong(4) = LON(3) * 39370.0792 'pulgadas
        txtLong(5) = LON(3) * 3280.83993 'pies
        txtLong(6) = LON(3) * 1093.61331 'yardas
        txtLong(7) = LON(3) * 0.6213712  'millas
    End If

    Case 4 'pulgadas
    If LONGITUD(4) = True Then
        LON(4) = CDbl(txtLong(4))
        txtLong(0) = LON(4) * 25.4       'milímetros
        txtLong(1) = LON(4) * 2.54 '     'centímetros
        txtLong(2) = LON(4) * 0.0254     'metros
        txtLong(3) = LON(4) * 0.0000254  'kilómetros
        txtLong(5) = LON(4) * 0.08333333 'pies
        txtLong(6) = LON(4) * 0.02777778 'yardas
        txtLong(7) = LON(4) * 0.00001578 'millas
    End If

    Case 5 'pies
    If LONGITUD(5) = True Then
        LON(5) = CDbl(txtLong(5))
        txtLong(0) = LON(5) * 304.8      'milímetros
        txtLong(1) = LON(5) * 30.48      'centímetros
        txtLong(2) = LON(5) * 0.3048     'metros
        txtLong(3) = LON(5) * 0.0003048  'kilómetros
        txtLong(4) = LON(5) * 12         'pulgadas
        txtLong(6) = LON(5) * 0.33333333 'yardas
        txtLong(7) = LON(5) * 0.00018939 'millas
    End If
    
    Case 6 'yardas
    If LONGITUD(6) = True Then
        LON(6) = CDbl(txtLong(6))
        txtLong(0) = LON(6) * 914.4      'milímetros
        txtLong(1) = LON(6) * 91.44      'centímetros
        txtLong(2) = LON(6) * 0.9144     'metros
        txtLong(3) = LON(6) * 0.0009144  'kilómetros
        txtLong(4) = LON(6) * 36         'pulgadas
        txtLong(5) = LON(6) * 3          'pies
        txtLong(7) = LON(6) * 0.00056818 'millas
    End If

    Case 7 'millas
    If LONGITUD(7) = True Then
        LON(7) = CDbl(txtLong(7))
        txtLong(0) = LON(7) * 1609344  'milímetros
        txtLong(1) = LON(7) * 160934.4 'centímetros
        txtLong(2) = LON(7) * 1609.344 'metros
        txtLong(3) = LON(7) * 1.609344 'kilómetros
        txtLong(4) = LON(7) * 63360    'pulgadas
        txtLong(5) = LON(7) * 5280     'pies
        txtLong(6) = LON(7) * 1760     'yardas
    End If

End Select
End Sub

Private Sub txtLong_GotFocus(Index As Integer)
Select Case Index

    Case 0
    LONGITUD(0) = True 'Conecta la bandera de milímetros
        
    Case 1
    LONGITUD(1) = True 'Conecta la bandera de centímetros

    Case 2
    LONGITUD(2) = True 'Conecta la bandera de metros

    Case 3
    LONGITUD(3) = True 'Conecta la bandera de kilómetros
    
    Case 4
    LONGITUD(4) = True 'Conecta la bandera de pulgadas

    Case 5
    LONGITUD(5) = True 'Conecta la bandera de pies
    
    Case 6
    LONGITUD(6) = True 'Conecta la bandera de yardas

    Case 7
    LONGITUD(7) = True 'Conecta la bandera de millas
    
End Select
End Sub

Private Sub txtLong_LostFocus(Index As Integer)
Select Case Index

    Case 0
    LONGITUD(0) = False 'Desconecta la bandera de milímetros
    
    Case 1
    LONGITUD(1) = False 'Desconecta la bandera de centimetros
    
    Case 2
    LONGITUD(2) = False 'Desconecta la bandera de metros
    
    Case 3
    LONGITUD(3) = False 'Desconecta la bandera de kilómetros
    
    Case 4
    LONGITUD(4) = False 'Desconecta la bandera de pulgadas
    
    Case 5
    LONGITUD(5) = False 'Desconecta la bandera de pies

    Case 6
    LONGITUD(6) = False 'Desconecta la bandera de yardas

    Case 7
    LONGITUD(7) = False 'Desconecta la bandera de millas

End Select
End Sub

Como ves, el código es una repetición de pasos (comprobar si está conectada la bandera, multiplicar por la equivalencia, desconectar la bandera) para cada medida, ya que cada una tiene distintas equivalencias. Si tenés alguna pregunta, comentario o sugerencia, no dudes en escribirme: [email protected]

Hasta la prómixa (no andes haciendo líos, para eso estoy yo "El Maestro del Desastre").

Fichero con el código de ejemplo: ElMaestroDelDesastre_ConvertidorDeMedidas.zip - Tamaño 8,45 KB