进制转换的代码

zele 2011-02-12

展开全文

'10 to 16
Public Function Dec2Hex$(ByVal lngS&)
Dim t$
t = Hex(lngS)
If (Len(t) And 1) = 1 Then t = "0" & t
Dec2Hex = t
End Function
'16 to 2
Public Function Hex2Bin$(ByVal strHex$)
Const hS As String = "0124937FEDA5B6C8"
Const bhS As String = "0000100111101011000"
Dim i%
For i = 1 To Len(strHex)
Hex2Bin = Hex2Bin & Mid$(bhS, InStr(1, hS, Mid$(strHex, i, 1), vbTextCompare), 4)
Next
End Function
'10 to 2
Public Function Dec2Bin$(ByVal lngS&)
Dec2Bin = Hex2Bin(Dec2Hex(lngS))
End Function
'10 to 8
Public Function Dec2Oct$(ByVal lngS&)
Dec2Oct = Oct(lngS)
End Function
'8 to 2
Public Function Oct2Bin$(ByVal strOct$)
Const oS As String = "01253764"
Const boS As String = "0001011100"
Dim i%
For i = 1 To Len(strOct)
Oct2Bin = Oct2Bin & Mid$(boS, InStr(1, oS, Mid$(strOct, i, 1), vbTextCompare), 3)
Next
End Function
'2 to 8
Public Function Bin2Oct$(ByVal strBin$)
Const oS As String = "01253764"
Const boS As String = "0001011100"
Dim i%, t$
strBin = Right$("00" & strBin, ((Len(strBin) + 2) \ 3) * 3)
For i = 1 To Len(strBin) Step 3
t = t & Mid$(oS, InStr(1, boS, Mid$(strBin, i, 4), vbTextCompare), 1)
Next
Bin2Oct = t
End Function
'2 to 16
Public Function Bin2Hex$(ByVal strBin$)
Const hS As String = "0124937FEDA5B6C8"
Const bhS As String = "0000100111101011000"
Dim i%, t$
strBin = Right$("000" & strBin, ((Len(strBin) + 3) \ 4) * 4)
For i = 1 To Len(strBin) Step 4
t = t & Mid$(hS, InStr(1, bhS, Mid$(strBin, i, 4), vbTextCompare), 1)
Next
If (Len(t) And 1) = 1 Then t = "0" & t
Bin2Hex = t
End Function
'2 to 10
Public Function Bin2Dec&(ByVal strBin$)
Bin2Dec = CLng("&H0" & Bin2Hex(strBin))
End Function
'16 to 10
Public Function Hex2Dec&(ByVal strHex$)
Hex2Dec = CLng("&H0" & strHex)
End Function
'16 to 8
Public Function Hex2Oct$(ByVal strHex$)
Hex2Oct = Bin2Oct(Hex2Bin(strHex))
End Function
'8 to 16
Public Function Oct2Hex$(ByVal strOct$)
Oct2Hex = Bin2Hex(Oct2Bin(strOct))
End Function
'8 to 10
Public Function Oct2Dec&(ByVal strOct$)
Oct2Dec = Hex2Dec(Oct2Hex(strOct))
End Function