Это часть программы, переводящей числа из 10 системы счисления в другую. И целую и дробную часть.
Это двоичная система. С 8 и 16 все сделано по такому же принципу, но все работает и все выводит
| Код |
Private Sub Command1_Click()
Dim nachalo As Long, konec As Single, a As Long, b As Long, C() As Integer, M() As String, konec1 As String, p As Integer, konecHexNew As String
label1.Caption = "Введённое число:"
Label2.Visible = True
Label3.Visible = True
Label4.Visible = True
Text2.Visible = True
Text3.Visible = True
Text4.Visible = True
dec = Val(Text1.Text)
l = Len(Text1.Text)
For i = 1 To l
If Mid(Text1.Text, i, 1) = "." Then
razd = i
End If
Next
nachalo = Left(Text1.Text, (razd - 1))
konec = dec - nachalo
nachaloBin = nachalo
nachaloHex = nachalo
nachaloOct = nachalo
konecBin = konec
konecHex = konec
konecOct = konec
'Перевод начала в двоичную сс
i = 0
a = nachaloBin Mod 2
b = nachaloBin \ 2
ReDim C(0) As Integer
C(0) = a
Do While b <> 0
i = i + 1
ReDim Preserve C(i) As Integer
a = b Mod 2
b = b \ 2
C(i) = a
Loop
For x = i To 0 Step -1
Text2.Text = Text2.Text & Str(C(x))
Next
'Перевод конца в двоичную сс
n = Val(Text5.Text)
konecBin = konecBin * 2
For i = 1 To n
j = 1
If Fix(konecBin) <> 0 Then
Do While Mid(konecBin, j, 1) <> ","
konecBinNew = konecBinNew + Mid(konecBin, j, 1)
j = j + 1
Loop
konecBin = Val("0." + Right(konecBin, (Len(konecBin) - (j))))
konecBin = konecBin * 2
Else
konecBinNew = konecBinNew + "0"
konecBin = konecBin * 2
End If
Next
'слепливаем начало и конец!))
Text2.Text = Text2.Text & "," & konecBinNew
'Перевод начала в восьмиричную сс
i = 0
a = nachaloOct Mod 8
b = nachaloOct \ 8
ReDim C(0) As Integer
C(0) = a
Do While b <> 0
i = i + 1
ReDim Preserve C(i) As Integer
a = b Mod 8
b = b \ 8
C(i) = a
Loop
For x = i To 0 Step -1
Text3.Text = Text3.Text + Str(C(x))
Next
'Перевод конца в восьмиричную сс
n = Val(Text5.Text)
konecOct = konecOct * 8
For i = 1 To n
j = 1
If Fix(konecOct) <> 0 Then
Do While Mid(konecOct, j, 1) <> ","
konecOctNew = konecOctNew + Mid(konecOct, j, 1)
j = j + 1
Loop
konecOct = Val("0." + Right(konecOct, (Len(konecOct) - (j))))
konecOct = konecOct * 8
Else
konecOctNew = konecOctNew + "0"
konecOct = konecOct * 8
End If
Next
'слепливаем начало и конец!))
Text3.Text = Text3.Text + "," + konecOctNew
dec = Val(Text1.Text)
Text2.Text = ""
a = nachaloHex Mod 16
b = nachaloHex \ 16
ReDim M(0) As String
M(0) = a
Do While b <> 0
i = i + 1
ReDim Preserve M(i) As String
a = b Mod 16
b = b \ 16
M(i) = a
Loop
For x = i To 0 Step -1
If M(x) = "10" Then
M(x) = "A"
ElseIf M(x) = "11" Then
M(x) = "B"
ElseIf M(x) = "12" Then
M(x) = "C"
ElseIf M(x) = "13" Then
M(x) = "D"
ElseIf M(x) = "14" Then
M(x) = "E"
ElseIf M(x) = "15" Then
M(x) = "F"
End If
Text4.Text = Text4.Text + M(x)
Next
'Перевод конца в шестнадцатиричную сс
n = Val(Text5.Text)
konecHex = konecHex * 16
For i = 1 To n
j = 1
If Fix(konecHex) <> 0 Then
Do While Mid(konecHex, j, 1) <> ","
konecHexNew = konecHexNew + Mid(konecHex, j, 1)
j = j + 1
Loop
konecHex = Val("0." + Right(konecHex, (Len(konecHex) - (j))))
konecHex = konecHex * 16
Else
konecHexNew = konecHexNew + "0"
konecHex = konecHex * 16
End If
Next
konecHexNew = Hex(konecHexNew)
'слепливаем начало и конец!))konecHexNew = Chr(konecHexNew)
Text4.Text = Text4.Text + "," + konecHexNew
End Sub
|
|