VB中有没有进制互转函数呢？

VB中有没有进制互转函数呢？

答案：'完整的
'
Private Function ZH_2v8(ByVal fst As String) As String
'二进制转八进制
    Dim i As Integer
    If Len(fst) Mod 3 = 1 Then fst = "00" & fst
    If Len(fst) Mod 3 = 2 Then fst = "0" & fst
    For i = 1 To Len(fst) Step 3
        Select Case Mid(fst, i, 3)
            Case Is = "000": ZH_2v8 = ZH_2v8 & "0"
            Case Is = "001": ZH_2v8 = ZH_2v8 & "1"
            Case Is = "010": ZH_2v8 = ZH_2v8 & "2"
            Case Is = "011": ZH_2v8 = ZH_2v8 & "3"
            Case Is = "100": ZH_2v8 = ZH_2v8 & "4"
            Case Is = "101": ZH_2v8 = ZH_2v8 & "5"
            Case Is = "110": ZH_2v8 = ZH_2v8 & "6"
            Case Is = "111": ZH_2v8 = ZH_2v8 & "7"
        End Select
    Next i
End Function
Private Function ZH_2v10(ByVal fst As String) As String
'二进制转十进制
    Dim sLen As Long, i As Long, returnNum As Long
    sLen = Len(fst)
    For i = 0 To sLen - 1
        returnNum = returnNum + Val(Mid(fst, i + 1, 1)) * (2 ^ (sLen - i - 1))
    Next
    ZH_2v10 = returnNum
End Function
Private Function ZH_2v16(ByVal fst As String) As String
'二进制转16进制
    Dim i As Integer
    If Len(fst) Mod 4 = 1 Then fst = "000" & fst
    If Len(fst) Mod 4 = 2 Then fst = "00" & fst
    If Len(fst) Mod 4 = 3 Then fst = "0" & fst
    For i = 1 To Len(fst) Step 4
        Select Case Mid(fst, i, 4)
            Case Is = "0000": ZH_2v16 = ZH_2v16 & "0"
            Case Is = "0001": ZH_2v16 = ZH_2v16 & "1"
            Case Is = "0010": ZH_2v16 = ZH_2v16 & "2"
            Case Is = "0011": ZH_2v16 = ZH_2v16 & "3"
            Case Is = "0100": ZH_2v16 = ZH_2v16 & "4"
            Case Is = "0101": ZH_2v16 = ZH_2v16 & "5"
            Case Is = "0110": ZH_2v16 = ZH_2v16 & "6"
            Case Is = "0111": ZH_2v16 = ZH_2v16 & "7"
            Case Is = "1000": ZH_2v16 = ZH_2v16 & "8"
            Case Is = "1001": ZH_2v16 = ZH_2v16 & "9"
            Case Is = "1010": ZH_2v16 = ZH_2v16 & "A"
            Case Is = "1011": ZH_2v16 = ZH_2v16 & "B"
            Case Is = "1100": ZH_2v16 = ZH_2v16 & "C"
            Case Is = "1101": ZH_2v16 = ZH_2v16 & "D"
            Case Is = "1110": ZH_2v16 = ZH_2v16 & "E"
            Case Is = "1111": ZH_2v16 = ZH_2v16 & "F"
        End Select
    Next i
     
End Function
Private Function ZH_10v2(ByVal fst As String) As String
'十进制转二进制
    Dim spare As Integer  '
    
    If IsNumeric(fst) = True Then
        fst = Val(fst)
        Do While fst > 0
            spare = fst Mod 2
            fst = fst \ 2
            ZH_10v2 = Trim(Str(spare)) + ZH_10v2
        Loop
    Else
    
        MsgBox "请输入正确数值!", vbInformation, "提示"
    End If
  
End Function
Private Function ZH_10v8(ByVal fst As String) As String
'十进制转八进制
    ZH_10v8 = Oct(Val(fst))
    
End Function
Private Function ZH_10v16(ByVal fst As String) As String
'十进制转16进制
    ZH_10v16 = Hex(Val(fst))
    
End Function
Private Function ZH_16v2(ByVal fst As String) As String
'
    Dim i As Integer, xLen As Integer, result As String
    
    For i = 1 To Len(fst)
    Select Case Mid(fst, i, 1)
        Case Is = "0": result = result & "0000"
        Case Is = "1": result = result & "0001"
        Case Is = "2": result = result & "0010"
        Case Is = "3": result = result & "0011"
        Case Is = "4": result = result & "0100"
        Case Is = "5": result = result & "0101"
        Case Is = "6": result = result & "0110"
        Case Is = "7": result = result & "0111"
        Case Is = "8": result = result & "1000"
        Case Is = "9": result = result & "1001"
        Case Is = "A": result = result & "1010"
        Case Is = "B": result = result & "1011"
        Case Is = "C": result = result & "1100"
        Case Is = "D": result = result & "1101"
        Case Is = "E": result = result & "1110"
        Case Is = "F": result = result & "1111"
        End Select
    Next i
     
    If Mid(result, 1, 1) = "0" Then
    
        xLen = Len(result) - 1
        result = Right(result, xLen)
        
    ElseIf Mid(result, 2, 1) = "0" Then
    
        xLen = Len(result) - 2
        result = Right(result, xLen)
        
    ElseIf Mid(result, 3, 1) = "0" Then
    
        xLen = Len(result) - 3
        result = Right(result, xLen)
    End If
    ZH_16v2 = result
End Function
Private Function ZH_16v8() As Long
     ZH_16v8 = ZH_2v8(Text2.Text)
End Function
Private Function ZH_16v10() As Long
    ZH_16v10 = ZH_2v10(Text2.Text)
End Function
互转什么呢
有！
Hex 函数: 返回代表十六进制数值的 String; 
Oct 函数: 返回代表一数值的八进制值的Variant (String); 
十进制转为二进制函数

Public Function DecToBinary(dec As Integer)
Dim m As String, n As String, d As Integer
d = dec

Do
m = (d Mod 2) & m
d = d \ 2
Loop Until d = 0
DecToBinary = m

End Function



二进制转为十进制函数

Public Function BinaryToDec(bin As String)
Dim i As Integer, n As Integer, x As Integer, str As String, dec As Integer
n = Len(bin)
i = 0

Do
i = i + 1
n = n - 1
x = Val(str)
str = (x + (Mid(bin, i, 1) * 2 ^ n))
Loop Until n = 0
BinaryToDec = str

End Function 

上一个：怎样用VB修改快捷方式的路径？
下一个：求每天定时关机的VB代码？