by Richard Deeming (1 Submission)
Category: Math/Dates
Compatability: Visual Basic 5.0
Difficulty: Unknown Difficulty
Originally Published: Thu 17th August 2000
Date Added: Mon 8th February 2021
Rating: 
(1 Votes)
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
VBcoders
'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
No comments have been posted about Provided simple conversion between different number bases, including fractional parts. One function. Why not be the first to post a comment about Provided simple conversion between different number bases, including fractional parts. One function.