|
Clase para trabajar con distintos sistemas numéricos Fecha: 21/Feb/2005 (21/Feb/2005)
|
Ésta es mi primera colaboración en las páginas de El Guille, se trata de una clase para convertir distintos sistemas numéricos a otros. Trabaja con los sistemas Binario, Octal, Decimal y Hexadecimal.
Las funciones reciben como parámetros el número original (Numero) en formato String (para soportar las letras que usa el sistema hexadecimal), y Sistema, para especificar que sistema numérico que estamos ingresando.
A continuación sigue código en Visual Basic de la Clase Conversión:
Option Explicit Enum SistemaNumerico snBinario snOctal snDecimal snHexadecimal End Enum Private Function SeparadorDecimal() As String SeparadorDecimal = Mid$(Format$(0.5, "Standard"), 2, 1) End Function Function ConvertirADecimal(Numero As String, Sistema As SistemaNumerico) As Long Dim a As Integer, SimboloActual As String, Equivalente As Integer Dim b As Integer For a = 1 To Len(Numero) Equivalente = 0 SimboloActual = Mid(Numero, a, 1) If Sistema = snHexadecimal Then For b = 65 To 70 If SimboloActual = Chr(b) Then Equivalente = b - 55 End If Next End If If Equivalente = 0 Then Equivalente = CInt(SimboloActual) End If Select Case Sistema Case snBinario ConvertirADecimal = ConvertirADecimal + Equivalente * (2 ^ (Len(Numero) - a)) Case snOctal ConvertirADecimal = ConvertirADecimal + Equivalente * (8 ^ (Len(Numero) - a)) Case snHexadecimal ConvertirADecimal = ConvertirADecimal + Equivalente * (16 ^ (Len(Numero) - a)) End Select Next End Function Function ConvertirAHexadecimal(Numero As String, Sistema As SistemaNumerico)As String Dim SimboloActual As String, Valor As String, a As Long Dim Total As Long, Resto Total = 1 Select Case Sistema Case snBinario While Not Numero = "" If Len(Numero) <= 4 Then SimboloActual = Numero Numero = "" Else SimboloActual = Right$(Numero, 4) Numero = Mid(Numero, 1, Len(Numero) - 4) End If For a = 1 To Len(SimboloActual) If Mid(SimboloActual, 1, 1) = "0" Then SimboloActual = Mid(SimboloActual, 2) End If Next If SimboloActual = "" Then SimboloActual = "0" End If If SimboloActual = "1" Then Valor = "1" & Valor End If If SimboloActual = "0" Then Valor = "0" & Valor End If Select Case SimboloActual Case "10" Valor = "2" & Valor Case "11" Valor = "3" & Valor Case "100" Valor = "4" & Valor Case "101" Valor = "5" & Valor Case "110" Valor = "6" & Valor Case "111" Valor = "7" & Valor Case "1000" Valor = "8" & Valor Case "1001" Valor = "9" & Valor Case "1010" Valor = "A" & Valor Case "1011" Valor = "B" & Valor Case "1100" Valor = "C" & Valor Case "1101" Valor = "D" & Valor Case "1110" Valor = "E" & Valor Case "1111" Valor = "F" & Valor End Select Wend ConvertirAHexadecimal = Valor Case snDecimal While Not Total = 0 Total = Fix(CLng(Numero) / 16) Resto = CLng(Numero) - (Total * 16) Numero = Total Select Case Resto Case 10 Resto = "A" Case 11 Resto = "B" Case 12 Resto = "C" Case 13 Resto = "D" Case 14 Resto = "E" Case 15 Resto = "F" End Select ConvertirAHexadecimal = ConvertirAHexadecimal & Resto Wend ConvertirAHexadecimal = StrReverse(ConvertirAHexadecimal) Case snOctal Numero = CStr(ConvertirADecimal(Numero, snOctal)) While Not Total = 0 Total = Fix(CLng(Numero) / 16) Resto = CLng(Numero) - (Total * 16) Numero = Total Select Case Resto Case 10 Resto = "A" Case 11 Resto = "B" Case 12 Resto = "C" Case 13 Resto = "D" Case 14 Resto = "E" Case 15 Resto = "F" End Select ConvertirAHexadecimal = ConvertirAHexadecimal & Resto Wend ConvertirAHexadecimal = StrReverse(ConvertirAHexadecimal) End Select End Function Function ConvertirAOctal(Numero As String, Sistema As SistemaNumerico) Dim SimboloActual As String, Valor As String, a As Long Dim Total As Long, Resto Total = 1 Select Case Sistema Case snBinario While Not Numero = "" If Len(Numero) <= 3 Then SimboloActual = Numero Numero = "" Else SimboloActual = Right$(Numero, 3) Numero = Mid(Numero, 1, Len(Numero) - 3) End If For a = 1 To Len(SimboloActual) If Mid(SimboloActual, 1, 1) = "0" Then SimboloActual = Mid(SimboloActual, 2) End If Next If SimboloActual = "" Then SimboloActual = "0" End If If SimboloActual = "1" Then Valor = "1" & Valor End If If SimboloActual = "0" Then Valor = "0" & Valor End If Select Case SimboloActual Case "10" Valor = "2" & Valor Case "11" Valor = "3" & Valor Case "100" Valor = "4" & Valor Case "101" Valor = "5" & Valor Case "110" Valor = "6" & Valor Case "111" Valor = "7" & Valor End Select Wend ConvertirAOctal = Valor Case snDecimal While Not Total = 0 Total = Fix(CLng(Numero) / 8) Resto = CLng(Numero) - (Total * 8) Numero = Total ConvertirAOctal = ConvertirAOctal & Resto Wend ConvertirAOctal = StrReverse(ConvertirAOctal) Case snHexadecimal Numero = CStr(ConvertirADecimal(Numero, snHexadecimal)) While Not Total = 0 Total = Fix(CLng(Numero) / 8) Resto = CLng(Numero) - (Total * 8) Numero = Total ConvertirAOctal = ConvertirAOctal & Resto Wend ConvertirAOctal = StrReverse(ConvertirAOctal) End Select End Function Function ConvertirABinario(Numero As String, Sistema As SistemaNumerico) As String Dim Total As Long, Resto As Long, ActualBit As String, Division Dim a As Integer, SeccionBinaria As String, b As Integer Total = 1 Select Case Sistema Case snDecimal While Not Total <= 0 Division = CLng(Numero) / 2 Total = Fix(Division) Resto = CLng(Numero) - (Total * 2) Numero = Total If InStr(1, CStr(Division), SeparadorDecimal) > 0 Then ActualBit = "1" Else ActualBit = "0" End If ConvertirABinario = ConvertirABinario & ActualBit Wend ConvertirABinario = StrReverse(ConvertirABinario) Case snOctal For a = 1 To Len(Numero) ActualBit = Mid(Numero, a, 1) SeccionBinaria = ConvertirABinario(ActualBit, snDecimal) If SeccionBinaria = "1" Or SeccionBinaria = "0" Then While Len(SeccionBinaria) < 3 SeccionBinaria = "0" & SeccionBinaria Wend End If ConvertirABinario = ConvertirABinario & SeccionBinaria Next For a = 1 To Len(ConvertirABinario) If Mid(ConvertirABinario, 1, 1) = "0" Then ConvertirABinario = Mid(ConvertirABinario, 2) End If Next Case snHexadecimal For a = 1 To Len(Numero) ActualBit = Mid(Numero, a, 1) For b = 65 To 70 If ActualBit = Chr(b) Then ActualBit = b - 55 End If Next SeccionBinaria = ConvertirABinario(ActualBit, snDecimal) If SeccionBinaria = "1" Or SeccionBinaria = "0" Then While Len(SeccionBinaria) < 4 SeccionBinaria = "0" & SeccionBinaria Wend End If ConvertirABinario = ConvertirABinario & SeccionBinaria Next For a = 1 To Len(ConvertirABinario) If Mid(ConvertirABinario, 1, 1) = "0" Then ConvertirABinario = Mid(ConvertirABinario, 2) End If Next End Select End Function
Espero que les sirva, si quieren hacerme alguna pregunta o ayudarme a mejorarla escríbanme a [email protected].
Fichero con el código de ejemplo: felipe_Numeros.zip - Tamaño 3KB