• Home
 · 
• Math/Dates
 · 
• This module will convert Decimal, Binary, Hex, & Octal numbers to any of the previous. Add the modu

This module will convert Decimal, Binary, Hex, & Octal numbers to any of the previous. Add the modu

This module will convert Decimal, Binary, Hex, & Octal numbers to any of the previous. Add the module to any project and return the function.

Rate This module will convert Decimal, Binary, Hex, & Octal numbers to any of the previous. Add the modu

• 1
• 2
• 3
• 4
• 5

(1(1 Vote))

Dim Digit(30) As Double
Dim BinaryDigit(30) As Integer
Private BaseNumberFrom As String
Dim DecOut As Double
Dim LetterFound As Boolean
Dim Multiplier As Double
Dim HexStr As String
Dim OctStr As String
Dim I As Integer
Dim J As String
Dim K As Integer

Public Type ConvertFrom
    DECIMAL As String
    BINARY As String
    HEX As String
    OCTAL As String
End Type

Public Type ConvertTo
    To_Decimal As String
    To_Binary As String
    To_Hex As String
    To_Octal As String
End Type

Public Function CalculateBase(ByRef From As String, ConvertInTo As String, NumberFrom As String) As String
Select Case From
Case "DECIMAL"
     Select Case ConvertInTo
         Case "To_Decimal"
          CalculateBase = NumberFrom
         Case "To_Binary"
          CalculateBase = GetBinaryNumber(NumberFrom)
         Case "To_Hex"
          CalculateBase = HEX(NumberFrom)
         Case "To_Octal"
          CalculateBase = Oct(NumberFrom)
    End Select
'---------------------------------------------------------------------------------------------
Case "BINARY"
     Select Case ConvertInTo
         Case "To_Decimal"
          CalculateBase = GetDecimalNumber(NumberFrom)
         Case "To_Binary"
          CalculateBase = NumberFrom
         Case "To_Hex"
          CalculateBase = HEX(GetDecimalNumber(NumberFrom))
         Case "To_Octal"
          CalculateBase = Oct(GetDecimalNumber(NumberFrom))
    End Select
'---------------------------------------------------------------------------------------------
Case "HEX"
     Select Case ConvertInTo
         Case "To_Decimal"
          CalculateBase = HexToDecimal(NumberFrom)
         Case "To_Binary"
          CalculateBase = GetBinaryNumber(HexToDecimal(NumberFrom))
         Case "To_Hex"
          CalculateBase = NumberFrom
         Case "To_Octal"
          CalculateBase = Oct(HexToDecimal(NumberFrom))
    End Select
'---------------------------------------------------------------------------------------------
Case "OCTAL"
     Select Case ConvertInTo
         Case "To_Decimal"
          CalculateBase = OctalToDecimal(NumberFrom)
         Case "To_Binary"
          CalculateBase = GetBinaryNumber(OctalToDecimal(NumberFrom))
         Case "To_Hex"
          CalculateBase = HEX(OctalToDecimal(NumberFrom))
         Case "To_Octal"
          CalculateBase = NumberFrom
    End Select
End Select
End Function


Public Function GetBinaryNumber(Number As String) As String
Dim Locater As Integer
Dim DecimalCheck As Integer
Dim BinaryNumber As String


For I = 0 To 30
    BinaryDigit(I) = 0                          'set binary digits to Jero
Next I

I = 0

Digit(30) = 1

For I = 29 To 0 Step -1                          'multiply each successive digit by 2
    Digit(I) = Digit(I + 1) * 2
Next I

If Number > Digit(0) Then                        '2 to power 30 = this so check for bigger
    MsgBox "This Number is too Large"
    Exit Function
End If

DecimalCheck = InStr(1, Number, ".", vbTextCompare)     'look for decimal point

If DecimalCheck > 0 Then                        'if decimal found exit function
    MsgBox "please no decimals"
    Exit Function
End If

If Number < 0 Then                              'look for neative numbers
    MsgBox "please no negative numbers"
    Exit Function
End If

I = 0

For I = 0 To 30
   If Number >= Digit(I) Then
       Number = Number - Digit(I)
       BinaryDigit(I) = 1
   End If
Next I

I = 0                                                   'reset counter
BinaryNumber = 0

For I = 0 To 30                                         'put together binary sequence
    BinaryNumber = BinaryNumber & BinaryDigit(I)
Next I

    Locater = InStr(1, BinaryNumber, 1, vbTextCompare)   'look for first 1 in binary sequence
                                                    
    GetBinaryNumber = Mid(BinaryNumber, Locater, 30)         'remove leading Jeros

    
End Function

Public Function GetDecimalNumber(BinaryNumber As String) As String
Dim Locater As Double
Dim StrLength As Integer
Dim DecimalNumber As Double


Digit(0) = 1                                    'setup binary multipliers

I = 0
For I = 1 To 30
    Digit(I) = Digit(I - 1) * 2
Next I


StrLength = Len(BinaryNumber)                   'get length of binary string
BinaryNumber = StrReverse(BinaryNumber)         'reverse binary string

DecimalNumber = 0                               'reset decimal number

For I = 1 To StrLength
    Locater = Mid(BinaryNumber, I, 1)                                'get digit from binary string
    DecimalNumber = DecimalNumber + (Val(Digit(I - 1)) * Locater)    'multiply digit by binary power
Next I                                                               'and add to total

GetDecimalNumber = DecimalNumber


End Function

Function OctalToDecimal(myoct As String) As Double
    
    
    Multiplier = 1

    DecOut = 0
    OctStr = "01234567"
    For I = Len(myoct) To 1 Step -1
        J = Mid(myoct, I, 1)
        K = Val(InStr(1, OctStr, Val(J))) - 1
        If K + 1 = 0 Then
            MsgBox "Invalid input", , "Error"
            DecOut = -1
            Exit Function
        End If
        DecOut = DecOut + K * Multiplier
        Multiplier = Multiplier * 8
    Next I
    OctalToDecimal = DecOut


End Function

Function HexToDecimal(myHex As String) As String


    Multiplier = 1

    DecOut = 0
    HexStr = "0123456789ABCDEF"
    For I = Len(myHex) To 1 Step -1
        J = Mid(myHex, I, 1)
        
        Select Case CStr(J)
           Case "A"
             J = 10
             LetterFound = True
           Case "B"
             J = 11
             LetterFound = True
           Case "C"
             J = 12
             LetterFound = True
           Case "D"
             J = 13
             LetterFound = True
           Case "E"
             J = 14
             LetterFound = True
           Case "F"
             J = 15
             LetterFound = True
           Case Else
             LetterFound = False
             
        End Select
        
        Select Case LetterFound
            Case True
                DecOut = DecOut + Val(J) * Multiplier
            Case False
                K = Val(InStr(1, HexStr, Val(J))) - 1
                If K + 1 = 0 Then
                    MsgBox "Invalid input", , "Error"
                    DecOut = -1
                    Exit Function
                End If
                DecOut = DecOut + K * Multiplier
         End Select
        Multiplier = Multiplier * 16
    Next I
    HexToDecimal = DecOut
    

End Function