TODAY'S HEADLINES  |   ARTICLE ARCHIVE  |   FORUMS  |   TIP BANK
 Specialized Dev Zones Research Center eBook Library .NET Java C++ Web Dev Architecture Database Security Open Source Enterprise Mobile Special Reports 10-Minute Solutions DevXtra Blogs Slideshow

By submitting your information, you agree that devx.com may send you DevX offers via email, phone and text message, as well as email offers about other products and services that DevX believes may be of interest to you. DevX will process your information in accordance with the Quinstreet Privacy Policy.

 Home » Tip Bank » .NET » VB.NET » Math Processing
Language: VB5,VB6
Expertise: Intermediate
Jul 2, 2002

WEBINAR:On-Demand

Building the Right Environment to Support AI, Machine Learning and Deep Learning

Base Conversion module - A module to convert numbers between any bases

``````'-----------------------------------------------------------------
'   Module:     mBases
'   (C) 2000 Trinet Ltd, http://www.trinet.co.uk
'   Author:     R. Deeming (richard@trinet.co.uk)
'
'   Purpose:    To provide simple conversion between different
'               number bases, including fractional parts.
'
'               An example of advanced conversion is included:
'               the sexagesimal (base 60) system. For this
'               example, the numbers are represented as a
'               2-digit number from 0 to 59, followed by a colon.
'               For example, ConvertBase("12:30:", ebSexagesimal)
'               will return 750 (12 * 60 + 30). Note that the
'               structure of the number is strict - "12:30" and
'               "12:5:" are not valid numbers, but "12:30:" and
'               "12:05:" are.
'
'               When there are errors in the number, the code
'               will raise error 13, with a meaningful message.
'               To change the error number, change the constant
'               ERROR_NUMBER, or modify the code.
'
'   You may use and distribute this code, but you may not charge
'   for it or present it as your own work. If you find any bugs
'   in this code, please notify the author.
'   This code is provided "As-Is" - if it doesn't work, we accept
'   no responsibility.
'-----------------------------------------------------------------

'-----------------------------------------------------------------
' A complete explanation of bases is beyond the scope of this
' code, but a brief explanation is included.
'
' A number is represented as a series of digits, arranged in
' columns. The number of available digits is the same as the
' base of the number. Each column is indexed, starting at 0 for
' the "units" column, and the value of the column is equal to
' the base raised to the power of the index. We are accustomed to
' seeing this in decimal (base 10):
'
'   Index   2   1   0   .   -1  -2
'   ------------------------------
'   Value   2   3   4   .    2   5
'
' representing two hundred and thirty four and one quarter. This
' also applies to other bases. For example, in binary (base 2):
'
'   Index   2   1   0   .   -1  -2
'   ------------------------------
'   Value   1   0   1   .    0   1
'
' represents five and one quarter -
' 1 * 2^2 + 0 * 2^1 + 1 * 2^0 + 0 * 2^-1 + 1 * 2^-2
' = 4 + 0 + 1 + 0 + 0.25 = 5.25
'
' This concept extends to bases of any whole number greater than
' 1, and is limited only by the number of available symbols.
'-----------------------------------------------------------------

'-----------------------------------------------------------------
' To add more bases, perform the following steps:
'   1. Add the base to the Bases enum, and set its value to
'      the base (e.g. for base 4, add "ebBase4 = 4&"
'
'   2. If the base is greater than 10, or requires non-standard
'      representation of the numbers, add a private const with
'      the characters used to represent the digits (see
'      hexadecimal for an example), or modify the DigitLength
'      function and other functions (see ebSexagesimal)
'
'   3. In the procedures ConvertDigit and DeconvertDigit, add
'      the new base to the select statement. If you are using a
'      standard representation of a base <= 10, add the new enum
'      value to the first select statement. Otherwise, copy and
'
' Example:
'   Add ebAlphabet, a base 26 option in which all digits are
'   represented as letters of the alphabet.
'
'   Private Const AlphaChars = "ABCDEFGHIJKLMNOPQRSTUVWXYZ"
'
'   Public Enum Bases
'   ...
'       ebAlphabet = 26&
'
'   Private Function ConvertDigit(...)
'   ...
'       Case ebAlphabet:
'           ConvertDigit = Mid\$(AlphaChars, lngDigit + 1, 1)
'
'   Private Function DeconvertDigit(...)
'   ...
'       Case ebAlphabet:
'           lngTemp = InStr(1, AlphaChars, strDigit)
'           If lngTemp = 0 Then
'               err.raise error_number, "DeconvertDigit",
'  "Invalid Alpha Character"
'           Else
'               DeconvertDigit = lngTemp - 1
'           End If
'
'-----------------------------------------------------------------
Option Explicit

Private Const ERROR_NUMBER = 13&

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

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

Private Function DigitLength(Base As Bases) As Long
'Return the length of a digit in a given base
Select Case Base
Case ebSexagesimal:
DigitLength = 3

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

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)

ConvertDigit = Mid\$(HexChars, lngDigit + 1, 1)

Case ebAlphabet:
ConvertDigit = Mid\$(AlphaChars, lngDigit + 1, 1)

Case ebSexagesimal:
ConvertDigit = Right\$("00" & CStr(lngDigit), 2) & ":"

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

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

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),

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

'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.
'
'                   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, _
End If
End Function

Public Function LogB(ByVal dblNumber As Double, ByVal lBase As Long) As Double
LogB = Log(dblNumber) / Log(lBase)
End Function

``````
Richard Deeming

 Submit a Tip Browse ".NET" Tips Browse All Tips
Comment and Contribute

(Maximum characters: 1200). You have 1200 characters left.

Thanks for your registration, follow us on our social networks to keep up-to-date