convertbase.bas

金水区行政审批服务软件窗口系统

Attribute VB_Name = "subConvertBase"
'*******************************说明*********************************************************
'*这里的自定义函数能很好的完成转换的任务，尤其是可以转换Double数据类型，这点在              *
'*使用Windows注册表编程时很有用（转换DWords）。代码很复杂，需要脑子不停的转动，             *
'*请您仔细理解。其实这只是一个通用的函数，您可以提取思路用于自己的特定功能。                *
'*调用方法:                                                                                 *
'*Dim theValue As String                                                                    *
'*十进制 -> 十六进制                                                                        *
'*theValue = ConvertBase("100", 10, 16)                                                     *
'*二进制 -> 八进制                                                                          *
'*theValue = ConvertBase("100", 2, 8)                                                       *
'*十进制 -> 三进制                                                                          *
'*theValue = ConvertBase("100", 10, 3)                                                      *
'********************************************************************************************
Option Explicit
Public Function ConvertBase(NumValue As String, BaseFrom As Integer, BaseTo As Integer) As String
'============================================================================================
' 转换一个数值(NumValue)从一种进制(BaseFrom)到另一种进制(BaseTo)
'
' 用一个整数来表示各种进制：
' 二进制 = 2
' 八进制 = 8
' 十进制 = 10
' 十六进制 = 16
'
' NumValue是给定的数值字符串，包括 0 - 9, A - Z
' BaseFrom是给定的数值的进制，可以是2与36间的任何整数
' BaseTo是希望转换成的进制，可以是2与36间的任何整数
'
' 函数返回希望得到的进制数，是一个String类型
'2003-08-04 dww pm11:24进行了修改此函数实现进制的转换，因为在取得计算机号
'需要把得到2进制计算机号转换成10进制的计算机号
'============================================================================================
Dim i As Integer
Dim PlaceValue As Integer
Dim CurrentCharacter As String
Dim CharacterValue As Integer
Dim RunningTotal As Double
Dim Remainder As Double
Dim BaseOutDouble As Double
Dim NumInCaps As String
'确认NumValue有效
If NumValue = "" Or BaseFrom < 2 Or BaseFrom > 36 _
Or BaseTo < 1 Or BaseTo > 36 Then
ConvertBase = "Error"
Exit Function
End If
'使字母为大写
NumInCaps = UCase(NumValue)
'先将给定的数转换为十进制
PlaceValue = Len(NumInCaps)
For i = 1 To Len(NumInCaps)
PlaceValue = PlaceValue - 1
CurrentCharacter = Mid(NumInCaps, i, 1)
CharacterValue = 0
If Asc(CurrentCharacter) > 64 And _
Asc(CurrentCharacter) < 91 Then
CharacterValue = Asc(CurrentCharacter) - 55
End If
If CharacterValue = 0 Then
If Asc(CurrentCharacter) < 48 Or _
Asc(CurrentCharacter) > 57 Then
ConvertBase = "Error"
Exit Function
Else
CharacterValue = Val(CurrentCharacter)
End If
End If
If CharacterValue < 0 Or CharacterValue > BaseFrom - 1 Then
ConvertBase = "Error"
Exit Function
End If
RunningTotal = RunningTotal + CharacterValue * (BaseFrom ^ PlaceValue)
Next i
' 将得到的十进制数转换为目标进制
Do
BaseOutDouble = CDbl(BaseTo)
Remainder = ModDouble(RunningTotal, BaseOutDouble)
RunningTotal = (RunningTotal - Remainder) / BaseTo
If Remainder >= 10 Then
CurrentCharacter = Chr(Remainder + 55)
Else
CurrentCharacter = right(Str(Remainder), _
Len(Str(Remainder)) - 1)
End If
ConvertBase = CurrentCharacter & ConvertBase
Loop While RunningTotal > 0
End Function
Public Function ModDouble(NumValue As Double, DivNum As Double) As Double
'返回一个由小数点分开的数，用于Double数据类型
ModDouble = NumValue - (Int(NumValue / DivNum) * DivNum)
End Function