Clase para trabajar con distintos sistemas numéricos
Para trabajar con números Binarios, Octales, Decimales y Hexadecimales

Fecha: 21/Feb/2005 (21/Feb/2005)
Autor: Felipe Tapia P. - [email protected] / [email protected]

 


É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].


ir al índice

Fichero con el código de ejemplo: felipe_Numeros.zip - Tamaño 3KB