Venga, lo explico por si ayuda a alguien y de paso por si quereis comentar qué tal está (tened en cuenta que aún estoy empezando

) a ver......
Pues primero pensé en hacer 6 funciones. 3 para pasar de de decimal a binario, octal y hexadecimal y otras 3 para los pasos inversos.
Luego detectar en cual de las 4 cajas de texto escribe el usuario, leer el número que ha escrito, pasarlo a decimal y luego de decimal a los otros 2 (si ya lo pone en decimal, se pasa de decimal a los otros 3).
Pero al final lo he cambiado para hacerlo un poco más corto. He hecho 4 funciones, de decimal a binario, de binario a octal, de octal a hexa y de hexa a decimal.
Se detecta en cual escribe el usuario con una variable global llamada opcion que vale 0 si no ha escrito nada, 1 si ha escrito en decimal,etc hasta 4.
Cuando pulsa aceptar, se crea un bucle infinito, del que sólo se sale si opcion=0, y dentro de ese bucle están las 4 funciones una detrás de otra en la forma:
salir=1
BUCLE
SI opcion=1 lee el decimal, lo pasa a binario, y lo escribe en la
columna de binario. Luego incrementa la variable salir. Si salir
es 4 es que ya se han hecho todas las transformaciones, así
que se hace opcion=0, si no opcion=2
SI opcion=2 lee el binario, lo pasa a octal, y lo escribe en la
columna de octal. Luego incrementa la variable salir. Si salir
es 4 es que ya se han hecho todas las transformaciones, así
que se hace opcion=0, si no opcion=3
SI opcion=3 lee el octal, lo pasa a hexa, y lo escribe en la
columna de hexa. Luego incrementa la variable salir. Si salir
es 4 es que ya se han hecho todas las transformaciones, así
que se hace opcion=0, si no opcion=4
SI opcion=4 lee el hexa, lo pasa a decimal, y lo escribe en la
columna de decimal. Luego incrementa la variable salir. Si salir
es 4 es que ya se han hecho todas las transformaciones, así
que se hace opcion=0, si no opcion=1
FIN BUCLE SI opcion=0
De esta forma el bucle hace 1 vez (y sólo una) cada transformación, empezando por la opción donde haya escrito el usuario.
El código es este:
Option Explicit
Public opcion As Integer
Private Sub cmdAceptar_Click()
Dim numero As Long
Dim hexa As Long
Dim cifra As Integer
Dim suma As Integer
Dim n As Integer
Dim m As Integer
Dim numCeros As Integer
Dim cifraHex(3) As Integer
suma = 1
Do
If opcion = 1 Then
numero = Val(txtDec.Text)
Do
cifra = numero Mod 2
numero = numero \ 2
txtBin.Text = Mid(Str(cifra), 2) & txtBin.Text
Loop Until numero < 2
If numero <> 0 Then
txtBin.Text = Mid(Str(numero), 2) & txtBin.Text
End If
suma = suma + 1
If suma = 4 Then
opcion = 0
Else
opcion = 2
End If
End If
If opcion = 2 Then
cifra = Len(txtBin.Text)
If (cifra Mod 3) = 1 Then
txtBin.Text = "00" & txtBin.Text
cifra = cifra + 2
numCeros = 2
ElseIf (cifra Mod 3) = 2 Then
txtBin.Text = "0" & txtBin.Text
cifra = cifra + 1
numCeros = 1
End If
cifra = cifra \ 3
For n = 1 To cifra
numero = 4 * Val(Mid(txtBin.Text, 3 * (n - 1) + 1, 1))
numero = numero + 2 * Val(Mid(txtBin.Text, 3 * (n - 1) + 2, 1))
numero = numero + Val(Mid(txtBin.Text, 3 * n, 1))
txtOct.Text = txtOct.Text & Mid(Str(numero), 2)
Next n
If numCeros = 1 Then
txtBin.Text = Mid(txtBin.Text, 2)
ElseIf numCeros = 2 Then
txtBin.Text = Mid(txtBin.Text, 3)
End If
suma = suma + 1
If suma = 4 Then
opcion = 0
Else
opcion = 3
End If
End If
If opcion = 3 Then
cifra = Len(txtOct.Text)
If (cifra Mod 4) = 1 Then
txtOct.Text = "000" & txtOct.Text
cifra = cifra + 3
numCeros = 3
ElseIf (cifra Mod 4) = 2 Then
txtOct.Text = "00" & txtOct.Text
cifra = cifra + 2
numCeros = 2
ElseIf (cifra Mod 4) = 3 Then
txtOct.Text = "0" & txtOct.Text
cifra = cifra + 1
numCeros = 1
End If
cifra = cifra \ 4
For n = 1 To cifra
numero = 128 * Val(Mid(txtOct.Text, 4 * (n - 1) + 1, 1))
numero = numero + 16 * Val(Mid(txtOct.Text, 4 * (n - 1) + 2, 1))
numero = numero + 8 * Val(Mid(txtOct.Text, 4 * (n - 1) + 3, 1))
numero = numero + Val(Mid(txtOct.Text, 4 * n, 1))
For m = 0 To 2
cifraHex(m) = numero Mod 16
numero = numero \ 16
Next m
For m = 2 To 0 Step -1
If cifraHex(m) < 10 Then
txtHex.Text = txtHex.Text & Mid(Str(cifraHex(m)), 2)
Else
Select Case cifraHex(m)
Case 10
txtHex.Text = txtHex.Text & "A"
Case 11
txtHex.Text = txtHex.Text & "B"
Case 12
txtHex.Text = txtHex.Text & "C"
Case 13
txtHex.Text = txtHex.Text & "D"
Case 14
txtHex.Text = txtHex.Text & "E"
Case 15
txtHex.Text = txtHex.Text & "F"
Case Else
End Select
End If
Next m
Next n
If numCeros = 1 Then
txtOct.Text = Mid(txtOct.Text, 2)
ElseIf numCeros = 2 Then
txtOct.Text = Mid(txtOct.Text, 3)
ElseIf numCeros = 3 Then
txtOct.Text = Mid(txtOct.Text, 4)
End If
Do
n = Len(txtHex.Text)
m = Val(Left(txtHex.Text, 1))
If (m = 0) And (n <> 1) Then
txtHex.Text = Mid(txtHex.Text, 2)
Else
Exit Do
End If
Loop
suma = suma + 1
If suma = 4 Then
opcion = 0
Else
opcion = 4
End If
End If
If opcion = 4 Then
m = Len(txtHex.Text)
hexa = 16 ^ (m - 1)
numero = 0
For n = 1 To m
Select Case Mid(txtHex.Text, n, 1)
Case "A", "a"
numero = numero + 10 * hexa
Case "B", "b"
numero = numero + 11 * hexa
Case "C", "c"
numero = numero + 12 * hexa
Case "D", "d"
numero = numero + 13 * hexa
Case "E", "e"
numero = numero + 14 * hexa
Case "F", "f"
numero = numero + 15 * hexa
Case Else
numero = numero + Val(Mid(txtHex.Text, n, 1)) * hexa
End Select
hexa = hexa \ 16
Next n
txtDec.Text = Mid(Str(numero), 2)
suma = suma + 1
If suma = 4 Then
opcion = 0
Else
opcion = 1
End If
End If
Loop Until opcion = 0
End Sub
Private Sub cmdLimpiar_Click()
txtDec.Text = ""
txtBin.Text = ""
txtHex.Text = ""
txtOct.Text = ""
End Sub
Private Sub cmdSalir_Click()
End
End Sub
Private Sub mnuAyudaAcerca_Click()
Dim msg As Integer
msg = MsgBox(" Este programa no es freeware. Si no mandas 100€ a mi dirección en los próximos 3 días, te reventará el disco duro
, es coña." _
& vbCrLf & vbCrLf & " Llevo 2 días chapando manuales de VB y este es el primer fruto del estudio. Que os sea útil.", 64, "Cambio de Base by KeKo")
End Sub
Private Sub mnuAyudaInstr_Click()
Dim msg As Integer
msg = MsgBox(" Escribe un número en la casilla de la base en la que viene expresado y pulsa Aceptar para obtener su representación en las demás bases." _
& vbCrLf & vbCrLf & " Antes de escribir otro número pulsa Limpiar.", 64, "Instrucciones")
End Sub
Private Sub txtDec_Change()
opcion = 1
End Sub
Private Sub txtBin_Change()
opcion = 2
End Sub
Private Sub txtOct_Change()
opcion = 3
End Sub
Private Sub txtHex_Change()
opcion = 4
End Sub
Por ejemplo, Private Sub txtDec_Change() comprueba si la caja de texto llamada txtDec ha cambiado su contenido (es decir, si se ha escrito algo en ella), y de ser así hace opcion=1 para saber que la primera transformacion sera de decimal a binario.
Las demás igual.
En Private Sub mnuAyudaInstr_Click() se indica lo que debe hacer el programa si el usuario entra en el menú Ayuda/Instrucciones.
Private Sub cmdLimpiar_Click() indica que cuando el usuario haga click en el botón Limpiar, se borren las cajas de texto (las hace igual a "", o sea vacías)
La funcion Val( texto ) transforma un texto en su valor numérico. El usuario escribe un número, pero el ordenador lo toma como un texto, así que hay que usar esa función para que lo pase a número.
Len(texto) nos devuelve el número de letras de un texto.
mid(texto, inicio, n) lee n letras a partir de la posición inicio del texto indicado.
str(numero) es la inversa de val, es decir, pasa un número a formato texto. El texto que devuelve empieza con un espacio en blanco. Por ejemplo str(12) devuelve " 12". Para eliminar ese espacio, he combinado esta función con la mid de esta forma:
mid(str(numero), 2), con lo que obtengo el texto sin espacio inicial.
Si quereis comento las operaciones de cambio de base, pero en otro momento, que ya me canso de escribir

.
A ver si puedo adjuntar el ejecutable por si quereis verlo. Por cierto ¿cómo creo una instalación que incluya las librerías necesarias por si el que va a usar el programa no las tiene?
Salu2.