by Waty Thierry (60 Submissions)
Category: Math/Dates
Compatability: Visual Basic 3.0
Difficulty: Unknown Difficulty
Originally Published: Tue 13th April 1999
Date Added: Mon 8th February 2021
Rating: 
(1 Votes)
Convert between different bases ranging from 2 to 36
VBcoders
Option Explicit
Option Compare Text
'// Then declare this constant
Private Const csValidChars As String = "0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ"
'// Then all we have to do is to write a public function like this...
Public Function BCon(ByVal InputValue As String, ByVal InputBase As Long, ByVal OutputBase As Long) As String
'// Declare following variables
Dim cuOutputCharCount As Currency, lInputCharCount As Long
Dim lCounter As Long, sCompareWith As String, sChar As String
Dim dDecimalChars As Double, lPos As Long, cuBitValue As Currency
Dim cuDecimalValue As Currency, sOutput As String
'// Turn on error trapping
On Error Resume Next
'// Check to see that both InputBase and OutputBase are between 2 and 36 inclusively
If (InputBase < 2) Or (InputBase > 36) Then
BCon = ""
Exit Function
End If
If (OutputBase < 2) Or (OutputBase > 36) Then
BCon = ""
Exit Function
End If
'// Now initiate translation into 10-based value
InputValue = Trim(InputValue)
lInputCharCount = Len(InputValue)
sCompareWith = Left$(csValidChars, InputBase)
'// Check to see that input string is at least one character
If lInputCharCount < 1 Then
BCon = ""
Exit Function
End If
'// Loop through each character in input string. Check for invalid characters according to input base
For lCounter = 1 To lInputCharCount
sChar = Mid$(InputValue, lCounter, 1)
If InStr(1, sCompareWith, sChar, vbTextCompare) < 1 Then
BCon = ""
Exit Function
End If
Next
If InputBase = OutputBase Then
BCon = InputValue
Exit Function
End If
'// Now get the number of decimal characters needed to hold input value
dDecimalChars = lInputCharCount * Log(InputBase) / Log(10)
'// If decimal string is longer than 14 characters then exit function
If dDecimalChars > 14 Then
BCon = ""
Exit Function
End If
If InputBase = 10 Then
cuDecimalValue = CCur(InputValue)
Else
'// Initiate calculation into decimal value
cuBitValue = 1
cuDecimalValue = 0
'// As long there are characters left in input string, add their value into the decimal hold variable
While Len(InputValue) > 0
sChar = Right(InputValue, 1)
lPos = InStr(1, sCompareWith, sChar, vbTextCompare) - 1
cuDecimalValue = cuDecimalValue + lPos * cuBitValue
cuBitValue = cuBitValue * InputBase
InputValue = Left(InputValue, Len(InputValue) - 1)
Wend
'// Now we can do a trick. If output base is 10, we already have the decimal value...
If OutputBase = 10 Then
BCon = CStr(cuDecimalValue)
Exit Function
End If
End If
'// Calculate number of characters in output string. If not an integer round up to nearest integer
cuOutputCharCount = 1 + Log(cuDecimalValue) / Log(OutputBase)
'// Now we must convert the decimal value back into a string in the output base format
cuBitValue = 1
For lCounter = 2 To cuOutputCharCount
cuBitValue = cuBitValue * OutputBase
Next
'// As long as we have a decimal value greater than 0, add a character to the output string
sOutput = ""
sCompareWith = Left$(csValidChars, OutputBase)
While cuBitValue > 0
lPos = cuDecimalValue \ cuBitValue
sChar = Mid$(sCompareWith, 1 + lPos, 1)
sOutput = sOutput & sChar
cuDecimalValue = cuDecimalValue - lPos * cuBitValue
cuBitValue = cuBitValue \ OutputBase
Wend
'// Strip leading zeros
While Left$(sOutput, 1) < "1"
sOutput = Right$(sOutput, Len(sOutput) - 1)
Wend
'// Let BCon function value be the output string in output base format
BCon = sOutput
End Function
