Private Function HexChange(ByVal vHexCode As String) As String
On Error GoTo ErrOPR
vHexCode = UCase(vHexCode)
If Not IsNumeric("&H" & vHexCode) Then Exit Function
Dim i%
For i = 1 To Len(vHexCode)
HexChange = HexChange & DoHex(Mid(vHexCode, i, 1))
Next
Exit Function
ErrOPR:
HexChange = ""
End Function
Private Function DoHex(ByVal vHexCode As String) As String
Dim tA%, tB$, n%
tA = CInt("&H" & vHexCode)
Do Until tA = 0
n = tA Mod 2
tB = n & tB
tA = tA \ 2
Loop
DoHex = Format(tB, "0000")
End Function
Option Explicit
Public Function num2() As Double
Dim i As Integer
Dim x As String
Dim str As Double
Dim sum As Double
Dim m As Integer
For i = Len(Form1.Text1.Text) To 1 Step -1
x = Mid(Form1.Text1.Text, i, 1)
If Asc(x) > 47 And Asc(x) < 50 Then
str = Val(x) * 2 ^ m
Else
MsgBox ("输入不合法")
Form1.Text1.SetFocus
Form1.Text1.SelStart = i - 1
Form1.Text1.SelLength = 1
Exit Function
End If
sum = sum + str
m = m + 1
Next i
num2 = sum
End Function
Public Function huan8(ten As Double) As String
Dim eight As String
Dim n As Integer
Do Until ten = 0
n = ten Mod 8
eight = n & eight
ten = ten \ 8
Loop
huan8 = eight
End Function
Public Function huan16(ten As Double) As String
Dim sixteen As String
Dim n As Integer
Dim x As String
Do Until ten = 0
n = ten Mod 16
Select Case n
Case 10
x = "A"
Case 11
x = "B"
Case 12
x = "C"
Case 13
x = "D"
Case 14
x = "E"
Case 15
x = "F"
Case Else
x = n
End Select
sixteen = x & sixteen
ten = ten \ 16
Loop
huan16 = sixteen
End Function
Public Function num8() As Double
Dim i As Integer
Dim x As String
Dim str As Long
Dim sum As Long
Dim m As Integer
For i = Len(Form1.Text2.Text) To 1 Step -1
x = Mid(Form1.Text2.Text, i, 1)
If Asc(x) > 47 And Asc(x) < 56 Then
str = Val(x) * 8 ^ m
Else
MsgBox ("输入不合法")
Form1.Text2.SetFocus
Form1.Text2.SelStart = i - 1
Form1.Text2.SelLength = 1
Exit Function
End If
sum = sum + str
m = m + 1
Next i
num8 = sum
End Function
Public Function num16() As Double
Dim i As Integer
Dim x As String
Dim str As Double
Dim sum As Double
Dim m As Integer
For i = Len(Form1.Text3.Text) To 1 Step -1
x = Mid(Form1.Text3.Text, i, 1)
If (Asc(x) > 47 And Asc(x) < 58) Or (Asc(x) > 64 And Asc(x) < 91) Then
Select Case x
Case "A"
x = 10
Case "B"
x = 11
Case "C"
x = 12
Case "D"
x = 13
Case "E"
x = 14
Case "F"
x = 15
Case Else
x = x
End Select
str = Val(x) * 16 ^ m
Else
MsgBox ("输入不合法")
Form1.Text3.SetFocus
Form1.Text3.SelStart = i - 1
Form1.Text3.SelLength = 1
Exit Function
End If
sum = sum + str
m = m + 1
Next i
num16 = sum
End Function
Public Function huan2(ten As Double) As String
Dim two As String
Dim n As Double
Do Until ten = 0
n = ten Mod 2
two = n & two
ten = ten \ 2
Loop
huan2 = two
End Function
Function HextoBin(ByVal x As String) As String
Const Bins = "0000000100100011010001010110011110001001101010111100110111101111"
If IsNumeric("&h" & x) Then
Dim i As Integer
For i = 1 To Len(x)
HextoBin = HextoBin + Mid(Bins, (Val("&h" + Mid(x, i, 1)) * 4 + 1), 4)
Next
HextoBin = Format(HextoBin, "0")
End If
End Function