• Home
 · 
• Math/Dates
 · 
• Provided simple conversion between different number bases, including fractional parts. One function

Provided simple conversion between different number bases, including fractional parts. One function

Provided simple conversion between different number bases, including fractional parts. One function will convert between any specified bases.

API Declarations



Private Const ERROR_NUMBER = 13&

Private Const HexChars = "0123456789ABCDEF"
Private Const AlphaChars = "ABCDEFGHIJKLMNOPQRSTUVWXYZ"

Public Enum Bases
ebBinary = 2&
ebOctal = 8&
ebDecimal = 10&
ebHexadecimal = 16&
ebAlphabet = 26&
ebSexagesimal = 60& 'Base 60, e.g. time
End Enum



Rate Provided simple conversion between different number bases, including fractional parts. One function

• 1
• 2
• 3
• 4
• 5

(1(1 Vote))

'Return the length of a digit in a given base
    Select Case Base
        Case ebSexagesimal:
            DigitLength = 3
        
        'Add other special cases here
        
        Case Else   'ebBinary, ebOctal, ebDecimal, ebHexadecimal
            DigitLength = 1
    End Select
End Function

Private Function Floor(ByVal Number As Double) As Double
'Return the floor of the number
'(the highest whole number less than or equal to the number)
    If Int(Number) > Number Then
        Floor = Int(Number) - 1
    Else
        Floor = Int(Number)
    End If
End Function

Private Function GetNumDec(dblTemp As Double, PadTo As Long, Base As Bases) As Long
'Return the number of digits required to represent
'the number dblTemp in the specified base, padded
'to the nearest multiple of PadTo

Dim lTemp As Long, lTempPad As Double
    
    If dblTemp = 0 Then
        lTemp = 1
    Else
        lTemp = Floor(Log(dblTemp) / Log(Base)) + 1
    End If
    If PadTo > 1 Then
        lTempPad = lTemp / CDbl(PadTo)
        If lTempPad > Floor(lTempPad) Then
            lTempPad = 1 + Floor(lTempPad) - lTempPad
            lTempPad = lTempPad * PadTo
            
            lTemp = lTemp + lTempPad
        End If
    End If
    GetNumDec = lTemp
End Function

Private Function ConvertDigit(lngDigit As Long, Base As Bases) As String
'Convert a single digit to the specified base
    If lngDigit >= Base Then
        Err.Raise ERROR_NUMBER, "ConvertDigit", "Invalid digit for base"
    Else
        Select Case Base
            Case ebBinary, ebOctal, ebDecimal:
                ConvertDigit = CStr(lngDigit)
            
            Case ebHexadecimal:
                ConvertDigit = Mid$(HexChars, lngDigit + 1, 1)
           
           Case ebAlphabet:
               ConvertDigit = Mid$(AlphaChars, lngDigit + 1, 1)
            
            Case ebSexagesimal:
                ConvertDigit = Right$("00" & CStr(lngDigit), 2) & ":"
                
            'Add other bases here
            Case Else: Err.Raise ERROR_NUMBER, "ConvertDigit", "Unknown base"
        End Select
    End If
End Function

Private Function DeconvertDigit(strDigit As String, Base As Bases) As Long
'Convert a single digit from the specified base to decimal
Dim lngTemp As Long
    Select Case Base
        Case ebBinary, ebOctal, ebDecimal:
            If IsNumeric(strDigit) Then
                lngTemp = CLng(strDigit)
                If lngTemp < Base Then
                    DeconvertDigit = lngTemp
                Else
                    Err.Raise ERROR_NUMBER, "DeconvertDigit", "Invalid digit for base"
                End If
            Else
                Err.Raise ERROR_NUMBER, "DeconvertDigit", "Invalid character"
            End If
            
        Case ebHexadecimal:
            lngTemp = InStr(1, HexChars, UCase$(strDigit))
            If lngTemp = 0 Then
                Err.Raise ERROR_NUMBER, "DeconvertDigit", "Invalid digit for base"
            Else
                DeconvertDigit = lngTemp - 1
            End If
            
       Case ebAlphabet:
           lngTemp = InStr(1, AlphaChars, UCase$(strDigit))
           If lngTemp = 0 Then
               Err.Raise ERROR_NUMBER, "DeconvertDigit", "Invalid Alpha Character"
           Else
               DeconvertDigit = lngTemp - 1
           End If
            
        Case ebSexagesimal:
            If Len(strDigit) = 3 Then
                If Right$(strDigit, 1) = ":" And IsNumeric(Left$(strDigit, 2)) Then
                    lngTemp = CLng(Left$(strDigit, 2))
                    If lngTemp < Base Then
                        DeconvertDigit = lngTemp
                    Else
                        Err.Raise ERROR_NUMBER, "DeconvertDigit", "Invalid digit for base"
                    End If
                Else
                    Err.Raise ERROR_NUMBER, "DeconvertDigit", "Invalid digit for base"
                End If
            Else
                Err.Raise ERROR_NUMBER, "DeconvertDigit", "Invalid digit for base"
            End If
        
        'Add other bases here
        
        Case Else:
            Err.Raise ERROR_NUMBER, "DeconvertDigit", "Unknown base"
    End Select
End Function

Private Function ConvertDec2Base(ByVal Number, ByVal Base As Bases, Optional NumDecimals As Long = -1, Optional Tolerance As Double = 1E-27, Optional PadTo As Long = 0) As String
'Convert Number from decimal to the specified base,
'with NumDecimals fractional digits (or to within tolerance),
'padded to the nearest multiple of PadTo

Dim dblTemp As Double
Dim lCDec As Long
Dim lDigit As Long
Dim dblPwr As Double
Dim strTemp As String

    If Not IsNumeric(Number) Then
        Err.Raise ERROR_NUMBER, "ConvertDec2Base", "Number must be decimal"
    ElseIf Base < 2 Then
        Err.Raise ERROR_NUMBER, "ConvertDec2Base", "Invalid base"
    Else
        'Negative tolerance could cause loops
        Tolerance = Abs(Tolerance)
        
        dblTemp = CDbl(Number)
        If dblTemp < 0 Then
            strTemp = "-"
            dblTemp = -dblTemp
        End If
        
        lCDec = GetNumDec(dblTemp, PadTo, Base)
        
        'Integer part
        If lCDec = 0 Then
            strTemp = strTemp & "0"
        Else
            Do Until lCDec = 0
                lCDec = lCDec - 1
                dblPwr = Base ^ lCDec
                lDigit = 0
                Do While dblTemp >= dblPwr
                    lDigit = lDigit + 1
                    dblTemp = dblTemp - dblPwr
                Loop
                strTemp = strTemp & ConvertDigit(lDigit, Base)
            Loop
        End If
        
        'Fractional part
        If dblTemp > Tolerance And (NumDecimals > 0 Or (NumDecimals = -1 And Tolerance > 0)) Then
            strTemp = strTemp & "."
            Do While dblTemp > Tolerance And (lCDec > (-NumDecimals) Or NumDecimals = -1)
                lCDec = lCDec - 1
                dblPwr = Base ^ lCDec
                lDigit = 0
                Do While dblTemp >= dblPwr
                    lDigit = lDigit + 1
                    dblTemp = dblTemp - dblPwr
                Loop
                strTemp = strTemp & ConvertDigit(lDigit, Base)
            Loop
        End If
        ConvertDec2Base = strTemp
    End If
End Function

Private Function ConvertBase2Dec(ByVal Number As String, ByVal Base As Bases) As Double
'Convert the number from the specified base to decimal
Dim dblTemp As Double
Dim strDigit As String, lngDigit As Long, i As Long
Dim lngPwr As Long, lngSign As Long, lngDigitSize
    
    If Base < 2 Then
        Err.Raise ERROR_NUMBER, "ConvertBase2Dec", "Invalid Base"
    Else
        lngDigitSize = DigitLength(Base)
        lngPwr = 0
        lngSign = 1
        i = 1
        Do Until i > Len(Number)
            strDigit = Mid$(Number, i, lngDigitSize)
            If Left$(strDigit, 1) = "." Then
                i = i + 1
                If lngPwr = 0 Then
                    lngPwr = 1
                Else
                    Err.Raise ERROR_NUMBER, "ConvertBase2Dec", "More than one decimal point"
                End If
            ElseIf Left$(strDigit, 1) = "-" Then
                i = i + 1
                If lngPwr = 0 And dblTemp = 0 Then
                    lngSign = -lngSign
                Else
                    Err.Raise ERROR_NUMBER, "ConvertBase2Dec", "Invalid negation"
                End If
            Else
                i = i + lngDigitSize
                lngDigit = DeconvertDigit(strDigit, Base)
                dblTemp = dblTemp * Base + lngDigit
                lngPwr = lngPwr * Base
            End If
        Loop
        If lngPwr > 1 Then
            ConvertBase2Dec = CDbl(lngSign) * (dblTemp / CDbl(lngPwr))
        Else
            ConvertBase2Dec = CDbl(lngSign) * dblTemp
        End If
    End If
End Function

Public Function ConvertBase(ByVal Number, ByVal FromBASE As Bases, Optional ByVal ToBASE As Bases = ebDecimal, Optional NumDecimals As Long = -1, Optional Tolerance As Double = 1E-27, Optional PadTo As Long = 0) As Variant
'Convert a number from one base to another.
'Parameters:
'       Number      A numeric value (when FromBASE = ebDecimal) or
'                   a string representing the number to convert
'
'       FromBASE    The base to convert from (enumeration)
'
'       ToBASE      (Optional) The base to convert to. Default = Decimal
'
'       NumDecimals (Optional) The number of decimal places to include
'                   when converting a fractional number to a non-decimal
'                   Specify 0 for integer only, or -1 to use tolerance.
'                   (This prevents problems with infinte loops)
'
'       Tolerance   (Optional) The value at which to terminate the
'                   fractional representation. If NumDecimals = -1
'                   and Tolerance = 0, no attempt will be made, to
'                   avoid an infinite loop. The sign of the tolerance
'                   is ignored.
'
'       PadTo       (Optional) Used to pad the non-decimal number
'                   to a given length. EG, binary numbers are
'                   normally shown with a multiple of 8 digits, so
'                   you would specify 8. Use 0 to avoid padding.
'
'Returns:
'       Either a double (if ToBASE = ebDecimal) or a string representing
'       the converted number.

Dim dblDec As Double
    If FromBASE = ebDecimal Then
        If IsNumeric(Number) Then
            dblDec = CDbl(Number)
        Else
            Err.Raise ERROR_NUMBER, "ConvertBase", "Not a decimal number"
        End If
    Else
        dblDec = ConvertBase2Dec(CStr(Number), FromBASE)
    End If
    If ToBASE = ebDecimal Then
        ConvertBase = dblDec
    Else
        ConvertBase = ConvertDec2Base(dblDec, ToBASE, NumDecimals, Tolerance, PadTo)
    End If
End Function