baseconv.bas

数字处理函数包(5KB)15datediff.zip指定两个日期计算相隔的天数

Attribute VB_Name = "modBaseConv"
Option Explicit

Function Bin$(ByVal dec#)

' Description
'     Converts a decimal number to a binary number
'
' Parameters
'     Name                 Type              Contains
'     -----------------------------------------------------------------------------
'     dec                  Double            Decimal number
'
' Returns
'     Binary number
'
' Uses
'     <Module name>:<Procedure Name>
'
' Last modified by
'     Jens Balchen : Date 1996-09-05 : Rev 1.0.0 : First working version

   Bin$ = ToBase$(dec#, 2)
   
End Function

Function FromBase#(ByVal number$, ByVal base_num%)

' Description
'     Converts the number contained in number$ from the base
'     specified in base_num% to the decimal system.
'
'     For this function, "." is considered the decimal separator
'
'     When a base system has digits higher than 9, the letters
'     in the alphabet will be considered replacements ->
'        A = 10
'        B = 11
'        C = 12
'        ...
'
' Parameters
'     Name                 Type              Contains
'     -----------------------------------------------------------------------------
'     number               String            The number to convert
'     base_num             Integer           The base of the number
'
' Returns
'     The converted number in decimal
'
' Uses
'     BASECONV.BAS : StrToNum
'
' Last modified by
'     Jens Balchen : Date 1996-09-05 : Rev 1.0.0 : First working version

Const DECIMALSEPARATOR = "."

Dim DSepPos%
Dim sFraction$, sReal$
Dim dFraction#, dReal#

Dim i%, CurrentNumber%

   ' Find the decimal separator
   DSepPos% = InStr(number$, DECIMALSEPARATOR)

   ' If there was none, we only have a real part, so...
   If DSepPos% = 0 Then
      sReal$ = number$
      sFraction$ = ""
   Else
      ' Extract real and fraction part
      sReal$ = Left$(number$, DSepPos% - 1)
      sFraction$ = Right$(number$, Len(number$) - DSepPos%)
   End If

   ' Now convert the two number strings to their decimal
   ' values
   For i% = Len(sReal$) To 1 Step -1
      CurrentNumber% = StrToNum%(Mid$(sReal$, i%, 1))
      dReal# = dReal# + (CurrentNumber% * (base_num% ^ (Len(sReal$) - i%)))
   Next i%

   For i% = 1 To Len(sFraction$)
      CurrentNumber% = StrToNum%(Mid$(sFraction$, i%, 1))
      dFraction# = dFraction# + (CurrentNumber% * (base_num% ^ (-i%)))
   Next i%

   ' Now put these together and return
   FromBase# = dReal# + dFraction#

End Function

Function NumToStr$(ByVal num%)

' Description
'     When a base system has digits higher than 9, the letters
'     in the alphabet will be considered replacements ->
'        A = 10
'        B = 11
'        C = 12
'        ...
'
' Parameters
'     Name                 Type              Contains
'     -----------------------------------------------------------------------------
'     num                  Integer           The number to convert from
'
' Returns
'     The converted string
'
' Uses
'     <Module name>:<Procedure Name>
'
' Last modified by
'     Jens Balchen : Date 1996-09-05 : Rev 1.0.0 : First working version

   If num% <= 9 Then
      NumToStr$ = CStr(num%)
   Else
      NumToStr$ = Chr$(num% - 9 + 64)
   End If

End Function

Function StrToNum%(ByVal number$)

' Description
'     When a base system has digits higher than 9, the letters
'     in the alphabet will be considered replacements ->
'        A = 10
'        B = 11
'        C = 12
'        ...
'
' Parameters
'     Name                 Type              Contains
'     -----------------------------------------------------------------------------
'     number               String            The number to convert
'
' Returns
'     The converted value
'
' Uses
'     <Module name>:<Procedure Name>
'
' Last modified by
'     Jens Balchen : Date 1996-09-05 : Rev 1.0.0 : First working version
'     Jens Balchen : Date 1996-09-09 : Rev 2.0.0 : Replaced Select Case with more
'                                                  logics to gain speed

Dim i%

   ' Calculate ASCII value and subtract 48 (ASCII 48 = 0), so that we get a number
   i% = Asc(number$) - 48
   '
   ' If this is greater than 9 (ie. ASCII > 57) we have a character, so we
   ' subtract 8 more (ASCII A - 48 = 17, it should be 10)
   If i% > 9 Then i% = i% - 7
   '
   ' Return the result
   StrToNum% = i%

End Function

Function ToBase$(ByVal dec#, ByVal base_num%)

' Description
'     Converts the number contained in decimal to the base
'     specified in base_num%.
'
'     For this function, "." is considered the decimal separator
'
'     When a base system has digits higher than 9, the letters
'     in the alphabet will be considered replacements ->
'        A = 10
'        B = 11
'        C = 12
'        ...
'
' Parameters
'     Name                 Type              Contains
'     -----------------------------------------------------------------------------
'     dec                  Double            The number to convert
'     base_num             Integer           The base of the number to convert to
'
' Returns
'     The converted number in base_num%
'
' Uses
'     BASECONV.BAS : StrToNum
'
' Last modified by
'     Jens Balchen : Date 1996-09-05 : Rev 1.0.0 : First working version

Const DECIMAL_SEPARATOR = "."

Dim lReal&, dFraction#
Dim sReal$, sFraction$
Dim temp#

Dim CurrentNumber%

   ' Separate the integer and the fraction
   lReal& = Int(dec#)
   dFraction# = dec# - lReal&
   
   ' Convert the Real part
   Do
      CurrentNumber% = (lReal& Mod base_num%)
      sReal$ = NumToStr$(CurrentNumber%) & sReal$
      lReal& = lReal& \ base_num%
   Loop Until lReal& = 0

   ' Convert the Fractional part
   Do Until (dFraction# = 0) Or (Len(sFraction$) = 4)
      temp# = dFraction# * base_num%
      CurrentNumber% = Int(temp#)
      sFraction$ = sFraction$ & NumToStr$(CurrentNumber%)
      dFraction# = (temp# - Int(temp#))
   Loop

   ' Add fraction only if we have one
   If sFraction$ <> "" Then
      ToBase$ = sReal$ & DECIMAL_SEPARATOR & sFraction$
   Else
      ToBase$ = sReal$
   End If

End Function