basecon2.bas

来自「数字处理函数包(5KB)15datediff.zip指定两个日期计算相隔的天数」· BAS 代码 · 共 79 行

Function BCON (ByVal OldBase As Integer, ByVal OldValue As Variant, ByVal NewBase As Integer, NewValue As Variant) As Integer

Dim Counter As Integer, Buffer As String
Dim ValidChars As String, DecimalValue As Double
Dim Character As String, Exponent As Double, Mantissa As Double

   
   On Error Resume Next

   ValidChars = "0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ"
   'Check if OldBase and NewBase are positive values.
   If (Abs(OldBase) <> OldBase) Or (Abs(NewBase) <> NewBase) Then
       BCON = False
       Exit Function
   End If
   'Check if OldBase and NewBase are between 2 and 36.
   If (OldBase < 2) Or (OldBase > 36) Or (NewBase < 2) Or (NewBase > 36) Then
       BCON = False
       Exit Function
   End If
   
   'Check to see if Old base is same as New base.
   If OldBase = NewBase Then
       NewValue = OldValue
       BCON = True
       Exit Function
   End If
   
   'Old value can only be integer value. Fractional values are not allowed.
   Buffer = CStr(OldValue)
   For Counter = 1 To Len(Buffer)
       Character = Mid$(Buffer, Counter, 1)
       If InStr(1, ValidChars, Character, 1) < 1 Then
           BCON = False
           Exit Function
       End If
   Next
   
   'Now we can start converting old value to new value
   If OldBase = 10 Then
       DecimalValue = CCur(OldValue)
   Else
       DecimalValue = 0
       Exponent = 1
       For Counter = Len(Buffer) To 1 Step -1
           Character = Mid$(Buffer, Counter, 1)
           Mantissa = InStr(1, ValidChars, Character, 1) - 1
           DecimalValue = DecimalValue + Mantissa * Exponent
           Exponent = Exponent * OldBase
       Next
   End If
   
   'Now we can start converting old value to new value
   If NewBase = 10 Then
       NewValue = CCur(DecimalValue)
       BCON = True
   Else
       NewValue = ""
       Exponent = 1
       For Counter = 1 To Int(Log(DecimalValue) / Log(NewBase))
           Exponent = Exponent * NewBase
       Next
       Counter = Int(Log(DecimalValue) / Log(NewBase))
       Do Until Counter < 0
           Mantissa = Int(DecimalValue / Exponent)
           Character = Mid$(ValidChars, Mantissa + 1, 1)
           NewValue = NewValue & Character
           Mantissa = Mantissa * Exponent
           DecimalValue = DecimalValue - Mantissa
           Exponent = Exponent / NewBase
           Counter = Counter - 1
       Loop
       BCON = True
   End If

End Function