'-----------------------------------------------------------------'   Module:     mBases'   (C) 2000 Trinet Ltd, http://www.trinet.co.uk'   Author:     R. Deeming ([email protected])''   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'      modify the hexadecimal option.'' 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 ExplicitPrivate 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. timeEnd EnumPrivate Function DigitLength(Base As Bases) As Long'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 SelectEnd FunctionPrivate 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 IfEnd FunctionPrivate 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 PadToDim 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 = lTempEnd FunctionPrivate 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 IfEnd FunctionPrivate Function DeconvertDigit(strDigit As String, Base As Bases) As Long'Convert a single digit from the specified base to decimalDim 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 SelectEnd FunctionPrivate 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 PadToDim dblTemp As DoubleDim lCDec As LongDim lDigit As LongDim dblPwr As DoubleDim 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 IfEnd FunctionPrivate Function ConvertBase2Dec(ByVal Number As String, _    ByVal Base As Bases) As Double'Convert the number from the specified base to decimalDim dblTemp As DoubleDim strDigit As String, lngDigit As Long, i As LongDim 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 IfEnd FunctionPublic 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 IfEnd FunctionPublic Function LogB(ByVal dblNumber As Double, ByVal lBase As Long) As Double    LogB = Log(dblNumber) / Log(lBase)End Function