Public Function Bin(ByVal n As Double, ByVal m As Long) As String
Dim i As Long, dot As Long, iP As Long, fP As Double
Dim prefix As String, BinInt As String, BinFloat As String
If Left(n, 1) = "-" Then prefix = "-": n = Mid(n, 2)
dot = InStr(n, ".")
If dot <> 0 Then iP = Left(n, dot - 1): fP = Mid(n, dot) Else iP = n
Do
BinInt = (iP Mod 2) & BinInt
iP = iP \ 2
Loop Until iP = 0
BinInt = prefix & BinInt
If dot = 0 Then Bin = BinInt: Exit Function
For i = 1 To m
fP = fP * 2
fP = (fP - Int(fP)) + (Int(fP) Mod 2)
BinFloat = BinFloat & Int(fP)
If fP = 1 Then Exit For
Next
Bin = BinInt & "." & BinFloat
End Function
Public Function Dec(ByVal n As String) As Double
Dim i As Long, j As Long, dot As Long, prefix As Long
prefix = Sgn(n)
If prefix = -1 Then n = Mid(n, 2)
dot = InStr(n, ".")
If dot = 0 Then
dot = Len(n) - 1
Else
n = Left(n, dot - 1) & Mid(n, dot + 1)
dot = dot - 2
End If
For i = dot To dot - Len(n) + 1 Step -1
j = j + 1
If Mid(n, j, 1) <> 0 Then Dec = Dec + 2 ^ i
Next
Dec = Dec * prefix
End Function
Private Sub Command2_Click()
Dim x As Double, max As Long
x = InputBox("请输入一个十进制数值")
'max = InputBox("请输入最多几个小数位")
If x > 100000000 Then
MsgBox "越位"
Exit Sub
End If
Text1.Text = "二进位 = " & Bin(x, 0)
Text2.Text = "转回十进位 = " & Dec(Bin(x, max))
'MsgBox "二进位 = " & Bin(x, 0) ' max)
'MsgBox "转回十进位 = " & Dec(Bin(x, max))
End Sub
Private Sub Command1_Click()
Dim a, b As Long
Dim c As String
a = Text1.Text
Do
If a = 0 Then Exit Do
If a > 1 Then
b = a Mod 2
Else
b = a
End If
c = CStr(b) & CStr(c)
a = a \ 2
Loop
Text2.Text = c
End Sub
Private Sub Command2_Click()
Dim a, b As String
Dim i, c, d As Long
a = Text2.Text
For i = 1 To Len(a)
c = CLng(Mid(a, i, 1))
If c = 1 Then
d = d + 2 ^ (Len(a) - i)
End If
Next
Text3.Text = d
End Sub