перевод из двоичной в десятичную и обратно

Dim s, n, g As String
Dim i, q As Integer
Dim j As String
Dim z As Double
 
Private Sub Command1_Click()
s = ""
n = ""
y = Text1.Text
k = Abs(Text1.Text)
 
For i = 0 To k
If (k Mod 2) = 0 Then
s = "0" + s
n = " 0" + n
Else
If (k Mod 2) = 1 Then
s = "1" + s
n = " 1" + n
End If
End If
k = Int(k / 2)
If k < 1 Then
r = i
Exit For
End If
Next
 
u = Split(n, " ")
 
If y >= 0 Then
Text2.Text = s
' ïåðåâîä èç 2-îé â 10óþ
z = 0
q = 0
i = 0
For q = UBound(u) To 1 Step -1
z = z + (u(q) * (2 ^ i))
i = i + 1
Next q
Text3.Text = z
 
ElseIf y < 0 Then
Text3.Text = ""
For q = 1 To UBound(u)
If u(q) = 0 Then
u(q) = 1
Else: If u(q) = 1 Then u(q) = 0
End If
Next
 
u(UBound(u)) = u(UBound(u)) + 1
n = ""
For q = UBound(u) To 1 Step -1
If u(q) > 1 Then
u(q - 1) = 1 + u(q - 1)
u(q) = 0
End If
n = u(q) + n
Next
Text2.Text = n
 
u(UBound(u)) = u(UBound(u)) - 1
 
q = 0
For q = UBound(u) To 1 Step -1
If u(q) < 0 Then
u(q - 1) = u(q - 1) - 1
u(q) = 1
End If
 
Next
 
For q = 1 To UBound(u)
If u(q) = 0 Then
u(q) = 1
Else: If u(q) = 1 Then u(q) = 0
End If
Next
 
q = 0
z = 0
i = 0
For q = UBound(u) To 1 Step -1
z = z + (u(q) * (2 ^ i))
i = i + 1
Next q
 
Text3.Text = "-" & z
Text4.Text = i
End If
End Sub
 
 
Private Sub Command2_Click()
End
End Sub

Private Sub Command1_Click()
Dim dec
dec = Val(Text1.Text)
Text2.Text = Trim(d_b(Abs(dec), 2, Sgn(dec)))
End Sub
Private Sub Command2_Click()
Text1.Text = b_d(Trim(Text2.Text))
End Sub
 
Function d_b$(ByVal x, o%, zn)
On Error GoTo er
 
Do While x > 0
    d_b = CStr(x Mod o) + d_b
    x = x \ o
Loop
 
d_b = dop(d_b, zn)
 
Exit Function
 
er: MsgBox Err.Description: Err.Clear
End Function
 
Function dop$(x$, zn)
Dim dt$
dt = "": dop = ""
 
For i = 1 To 32
    dt = IIf(i > Len(x), 0, Mid(StrReverse(x), i, 1)) & dt
Next i
 
If zn = -1 Then dt = x1(rev(Trim(dt)), 1)
 
For i = 1 To 32
   dop = dop & Mid(dt, i, 1): If i Mod 4 = 0 Then dop = dop & " "
Next i
 
End Function
 
Function b_d(ByVal x$)
Dim i%, zn$
On Error GoTo er
 
Do While InStr(1, x, " ") > 0
   x = Replace(x, " ", "")
Loop
 
zn = ""
If Mid(x, 1, 1) = 1 Then
   zn = "-"
   x = rev(x1(x, 0))
End If
 
b_d = 0
For i = 1 To Len(x)
     b_d = b_d + Val(Mid(x, 32 - i + 1, 1)) * 2 ^ (i - 1)
Next i
b_d = zn & b_d
 
Exit Function
er: MsgBox Err.Description: Err.Clear
End Function
Function rev$(x$)
Dim i%
For i = 1 To 32
   Mid(x, i, 1) = CStr(1 - Val(Mid(x, i, 1)))
Next i
rev = x
End Function
Function x1$(x$, u%)
Dim i%
i = 0
   Do While Mid(x, 32 - i, 1) = u
      Mid(x, 32 - i, 1) = 1 - u:
      i = i + 1
   Loop
   Mid(x, 32 - i, 1) = u:
x1 = x
End Function