Создать арифмометр, который переводит рациональные числа из двоичной системы в десятичную и обратно

@Prelest) · Регистрация: 22.03.2010

Студворк — интернет-сервис помощи студентам

Создать арифмометр (почти калькулятор), который переводит рациональные числа (а значит - и дробные) из двоичной системы в десятичную и обратно. Кроме того арифмометр должен складывать, вычитать, умножать и делить числа в ДВОИЧНОЙ системе счисления.
Программу можно писать на любом из языков: VB, Delphi, TP(если на нём возможно). В принципе - вообще на любом языке, боюсь просто, что его у меня может не быть.
Кроме того необязательно переводить в двоичную систему, можно и в восьмиричную.
Заранее всем спасибо, кто хочет помочь.

@YuraAAA · 23.03.2010, 02:13

Не обещаю, что код написан правильно ) пишу первый раз

так что не судите строго ))

Перевод из двоичной в десятичную

Visual Basic
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
Private Sub Command1_Click()
Dim a As Single, rez() As Single, rezult() As Single
a = Text1
k = 1
label1:
ReDim Preserve rez(1 To k) As Single
c = a \ 2
x = c * 2
rez(k) = a - x
a = c
If a = 0 Then GoTo label2
k = k + 1
If a = 1 Then
ReDim Preserve rez(1 To k) As Single
rez(k) = 1
GoTo label2
ElseIf a = 2 Then
ReDim Preserve rez(1 To k) As Single
rez(k) = 0
GoTo label2
End If
GoTo label1
label2:
ReDim Preserve rezult(1 To k) As Single
For i = 1 To k
rezult(k + 1 - i) = rez(i)
Next i
For i = 1 To k
MsgBox rezult(i)
Next i
End Sub

Перевод в десятичную из двоичной

Visual Basic
1
2
3
4
5
6
7
8
Private Sub Command2_Click()
Dim Dvo As String, rezult As Single
Dvo = Text2
For i = 1 To Len(Dvo)
rezult = rezult + Mid(Dvo, i, 1) * (2 ^ (Len(Dvo) - i))
Next i
MsgBox (rezult)
End Sub

Добавлено через 45 секунд
P.S. работает только с целыми числами

Добавлено через 38 минут
А операции совершаются исходя из двух этих функций:
Например. Сложить два двоичных числа. Значит переводим их в десятичный вид по второй процедуре,складываем как обычные числа,и результат переводим в двоичный вид по первой процедуре

Добавлено через 24 минуты
Тьфу) перепутался)

Перевод в двоичную

Visual Basic
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
Private Sub Command1_Click()
Dim a As Single, rez() As Single, rezult() As Single
a = Text1
k = 1
label1:
ReDim Preserve rez(1 To k) As Single
c = a \ 2
x = c * 2
rez(k) = a - x
a = c
If a = 0 Then GoTo label2
k = k + 1
If a = 1 Then
ReDim Preserve rez(1 To k) As Single
rez(k) = 1
GoTo label2
End If
GoTo label1
label2:
ReDim Preserve rezult(1 To k) As Single
For i = 1 To k
rezult(k + 1 - i) = rez(i)
Next i
For i = 1 To k
MsgBox rezult(i)
Next i
End Sub

Перевод в десятичную

Visual Basic
1
2
3
4
5
6
7
8
Private Sub Command2_Click()
Dim Dvo As String, rezult As Single
Dvo = Text2
For i = 1 To Len(Dvo)
rezult = rezult + Mid(Dvo, i, 1) * (2 ^ (Len(Dvo) - i))
Next i
MsgBox (rezult)
End Sub

Добавлено через 9 минут
ща напишу Вам арифмометр )

@YuraAAA · 23.03.2010, 02:35

ололо)вот что у меня получилось ) листинг программы:

Visual Basic
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
Private Sub Command1_Click()
Dim a As Single, rez() As Single, rezult() As Single, sss As String
a = Text1
k = 1
Label1:
ReDim Preserve rez(1 To k) As Single
c = a \ 2
x = c * 2
rez(k) = a - x
a = c
If a = 0 Then GoTo Label2
k = k + 1
If a = 1 Then
ReDim Preserve rez(1 To k) As Single
rez(k) = 1
GoTo Label2
End If
GoTo Label1
Label2:
ReDim Preserve rezult(1 To k) As Single
For i = 1 To k
rezult(k + 1 - i) = rez(i)
Next i
For i = 1 To k
sss = sss & rezult(i)
Next i
Label3 = "Результат: " & sss
End Sub
Private Sub Command2_Click()
Dim Dvo As String, rezult As Single
Dvo = Text1
For i = 1 To Len(Dvo)
rezult = rezult + Mid(Dvo, i, 1) * (2 ^ (Len(Dvo) - i))
Next i
Label3 = "Результат: " & rezult
End Sub
Private Sub Command3_Click()
Dim Dvo1 As String, Dvo2 As String, rezult As Single
Dim rez1 As Single, rez2 As Single, rez3 As Single
Dvo1 = Text1
Dvo2 = Text2
For i = 1 To Len(Dvo1)
rez1 = rez1 + Mid(Dvo1, i, 1) * (2 ^ (Len(Dvo1) - i))
Next i
For i = 1 To Len(Dvo2)
rez2 = rez2 + Mid(Dvo2, i, 1) * (2 ^ (Len(Dvo2) - i))
Next i
If Option4 = True Then
rez3 = rez1 + rez2
End If
If Option5 = True Then
rez3 = rez1 - rez2
End If
If Option6 = True Then
rez3 = rez1 * rez2
End If
If Option7 = True Then
rez3 = rez1 / rez2
End If
 
Dim a As Single, rez() As Single, rezultat() As Single, sss As String
a = rez3
k = 1
Label1:
ReDim Preserve rez(1 To k) As Single
c = a \ 2
x = c * 2
rez(k) = a - x
a = c
If a = 0 Then GoTo Label2
k = k + 1
If a = 1 Then
ReDim Preserve rez(1 To k) As Single
rez(k) = 1
GoTo Label2
End If
GoTo Label1
Label2:
ReDim Preserve rezultat(1 To k) As Single
For i = 1 To k
rezultat(k + 1 - i) = rez(i)
Next i
For i = 1 To k
sss = sss & rezultat(i)
Next i
Label3 = "Результат: " & sss
 
End Sub
 
Private Sub Command4_Click()
If MsgBox("Âû æåëàåòå âûéòè?;)", vbOKCancel, "exit") = vbOK Then
Unload Form1
Exit Sub
End If
End Sub
 
Private Sub Option1_Click()
If Option1 = True Then
Command2.Enabled = False
Command1.Enabled = True
Command3.Enabled = False
Text1.Enabled = True
Text2.Enabled = False
Frame1.Enabled = False
End If
End Sub
Private Sub Option2_Click()
If Option2 = True Then
Command2.Enabled = True
Command1.Enabled = False
Command3.Enabled = False
Text1.Enabled = True
Text2.Enabled = False
Frame1.Enabled = False
End If
End Sub
 
Private Sub Option3_Click()
If Option3 = True Then
Command2.Enabled = False
Command1.Enabled = False
Command3.Enabled = True
Text1.Enabled = True
Text2.Enabled = True
Frame1.Enabled = True
Option4 = True
End If
End Sub

@YuraAAA · 23.03.2010, 03:02

Ну это первая моя версия,так что багов целая куча будет =) Полностью рабочая такая штучка...наткнулся в нете за 650руб

Добавлено через 24 минуты
+Защита "от дураков" (на введение некорректных данных)

Visual Basic
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
[VB]Dim Char As Single
Private Sub Command1_Click()
If IsNumeric(Text1) = False Then
MsgBox ("Введите число")
Exit Sub
End If
Dim a As Single, rez() As Single, rezult() As Single, sss As String
a = Text1
k = 1
Label1:
ReDim Preserve rez(1 To k) As Single
c = a \ 2
x = c * 2
rez(k) = a - x
a = c
If a = 0 Then GoTo Label2
k = k + 1
If a = 1 Then
ReDim Preserve rez(1 To k) As Single
rez(k) = 1
GoTo Label2
End If
GoTo Label1
Label2:
ReDim Preserve rezult(1 To k) As Single
For i = 1 To k
rezult(k + 1 - i) = rez(i)
Next i
For i = 1 To k
sss = sss & rezult(i)
Next i
Label3 = "Результат: " & sss
End Sub
Private Sub Command2_Click()
If IsNumeric(Text1) = False Then
MsgBox ("Введите число")
Exit Sub
End If
For i = 1 To Len(Text1)
Char = Mid(Text1, i, 1)
If Char <> "0" Then
If Char <> "1" Then
MsgBox ("Введённое значение должно содержать только 0 или 1")
Exit Sub
End If
End If
Next i
Dim Dvo As String, rezult As Single
Dvo = Text1
For i = 1 To Len(Dvo)
rezult = rezult + Mid(Dvo, i, 1) * (2 ^ (Len(Dvo) - i))
Next i
Label3 = "Результат: " & rezult
End Sub
Private Sub Command3_Click()
If IsNumeric(Text1) = False Then
MsgBox ("Введите число")
Exit Sub
End If
If IsNumeric(Text2) = False Then
MsgBox ("Введите число")
Exit Sub
End If
 
For i = 1 To Len(Text1)
Char = Mid(Text1, i, 1)
If Char <> "0" Then
If Char <> "1" Then
MsgBox ("Введённое значение должно содержать только 0 или 1")
Exit Sub
End If
End If
Next i
For i = 1 To Len(Text2)
Char = Mid(Text2, i, 1)
If Char <> "0" Then
If Char <> "1" Then
MsgBox ("Введённое значение должно содержать только 0 или 1")
Exit Sub
End If
End If
Next i
Dim Dvo1 As String, Dvo2 As String, rezult As Single
Dim rez1 As Single, rez2 As Single, rez3 As Single
Dvo1 = Text1
Dvo2 = Text2
For i = 1 To Len(Dvo1)
rez1 = rez1 + Mid(Dvo1, i, 1) * (2 ^ (Len(Dvo1) - i))
Next i
For i = 1 To Len(Dvo2)
rez2 = rez2 + Mid(Dvo2, i, 1) * (2 ^ (Len(Dvo2) - i))
Next i
If Option4 = True Then
rez3 = rez1 + rez2
End If
If Option5 = True Then
rez3 = rez1 - rez2
End If
If Option6 = True Then
rez3 = rez1 * rez2
End If
If Option7 = True Then
rez3 = rez1 / rez2
End If
 
Dim a As Single, rez() As Single, rezultat() As Single, sss As String
a = rez3
k = 1
Label1:
ReDim Preserve rez(1 To k) As Single
c = a \ 2
x = c * 2
rez(k) = a - x
a = c
If a = 0 Then GoTo Label2
k = k + 1
If a = 1 Then
ReDim Preserve rez(1 To k) As Single
rez(k) = 1
GoTo Label2
End If
GoTo Label1
Label2:
ReDim Preserve rezultat(1 To k) As Single
For i = 1 To k
rezultat(k + 1 - i) = rez(i)
Next i
For i = 1 To k
sss = sss & rezultat(i)
Next i
Label3 = "Результат: " & sss
 
End Sub
 
Private Sub Command4_Click()
If MsgBox("Âû æåëàåòå âûéòè?;)", vbOKCancel, "exit") = vbOK Then
Unload Form1
Exit Sub
End If
End Sub
 
Private Sub Option1_Click()
If Option1 = True Then
Command2.Enabled = False
Command1.Enabled = True
Command3.Enabled = False
Text1.Enabled = True
Text2.Enabled = False
Frame1.Enabled = False
End If
End Sub
Private Sub Option2_Click()
If Option2 = True Then
Command2.Enabled = True
Command1.Enabled = False
Command3.Enabled = False
Text1.Enabled = True
Text2.Enabled = False
Frame1.Enabled = False
End If
End Sub
 
Private Sub Option3_Click()
If Option3 = True Then
Command2.Enabled = False
Command1.Enabled = False
Command3.Enabled = True
Text1.Enabled = True
Text2.Enabled = True
Frame1.Enabled = True
Option4 = True
End If
End Sub

[/VB]

@Prelest) · 23.03.2010, 16:11 **[ТС]**

Спасибо большое!!!!

Ехешник работает так, как надо. Ещё не проверяла саму программу, дома VB нет, завтра в универе посмотрю. Но спасибо вам огромное!!!!!

Впервые обращаюсь с такими просьбами. Даже не вериться, что здесь действительно помогают)))

@YuraAAA · 23.03.2010, 16:16

Всегда пожалуйста

Вот exe-шник с проверками на введённые данные )
Вот только дробные у меня не считает...пока что )

@YuraAAA · 23.03.2010, 16:17

С "защитой от дураков"

@Prelest) · 23.03.2010, 16:34 **[ТС]**

Точно! Я на радости такой совсем забыла про дробную часть.
Ещё не могли бы вы написать комментарии к основным частям программы?

Я в программировании - ноль.

@YuraAAA · 23.03.2010, 16:42

Как будет время-напишу,и попробую сделать дробную часть.Постараюсь сегодня

@Prelest) · 23.03.2010, 16:45 **[ТС]**

Спасибо

@YuraAAA · 23.03.2010, 19:28

Visual Basic
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
Dim Char As Single 
Private Sub Command1_Click()         ‘Процедура нажатия на кнопку 10->2
If IsNumeric(Text1) = False Then       ‘Проверка на число
MsgBox ("Введите число")
Exit Sub
End If
Dim a As Single, rez() As Single, rezult() As Single, sss As String
a = Text1
k = 1
Label1:
ReDim Preserve rez(1 To k) As Single       ‘этот блок заносит цифры двоичного             ‘числа в массив rez . Высчитывается оно по стандартному алгоритму остатков от ‘деления
c = a \ 2          ‘запоминаем целую часть от деления на 2
x = c * 2          ‘умножаем на 2
rez(k) = a – x     ‘разность этого и изначального будет 0 или 1
a = c              ‘полученую целую часть записываем как изначальную
If a = 0 Then GoTo Label2     ‘и идём к циклу 2.Окончанию
k = k + 1                     ‘иначе увеличиваем размерность массива k
If a = 1 Then                 ‘Проверяем,если полученое знач=1 тогда 
ReDim Preserve rez(1 To k) As Single     
‘элемент массива,то есть цифра двоичного числа будет =1
rez(k) = 1
GoTo Label2
End If
GoTo Label1
Label2:
ReDim Preserve rezult(1 To k) As Single   ‘По скольку полученый массив это ‘зеркальное отображение результата,то нужно его обратить 
For i = 1 To k
rezult(k + 1 - i) = rez(i) ‘Массив заполняется в обратном порядке
Next i
For i = 1 To k
sss = sss & rezult(i)         ‘Проведура вывода результата
Next i
Label3 = "Результат: " & sss
End Sub
 
Private Sub Command2_Click()      ‘Процедура нажатия на кнопку 2->10
If IsNumeric(Text1) = False Then       ‘Проверка на число
MsgBox ("Введите число")
Exit Sub
End If
For i = 1 To Len(Text1)        ‘Проверка на 0 или 1
Char = Mid(Text1, i, 1)
If Char <> "0" Then
If Char <> "1" Then
MsgBox ("Введённое значение должно содержать только 0 или 1")
Exit Sub
End If
End If
Next i
Dim Dvo As String, rezult As Single    
Dvo = Text1
‘перевод в десятичный код осуществляется по простому алгоритму.Это сумма произведений i-ой цифры числа на 2 в степени последний индекс –i 
For i = 1 To Len(Dvo)         
rezult = rezult + Mid(Dvo, i, 1) * (2 ^ (Len(Dvo) - i))
Next i
Label3 = "Результат: " & result      
End Sub
Private Sub Command3_Click()       ‘Эта процедура-смесь первой и второй
‘Смысл действия с двоичными: Переводим в десятичные,осуществляем ‘действия,переводим обратно 
If IsNumeric(Text1) = False Then
MsgBox ("Введите число")
Exit Sub
End If
If IsNumeric(Text2) = False Then
MsgBox ("Введите число")
Exit Sub
End If
 
For i = 1 To Len(Text1)
Char = Mid(Text1, i, 1)
If Char <> "0" Then
If Char <> "1" Then
MsgBox ("Введённое значение должно содержать только 0 или 1")
Exit Sub
End If
End If
Next i
For i = 1 To Len(Text2)
Char = Mid(Text2, i, 1)
If Char <> "0" Then
If Char <> "1" Then
MsgBox ("Введённое значение должно содержать только 0 или 1")
Exit Sub
End If
End If
Next i
Dim Dvo1 As String, Dvo2 As String, rezult As Single
Dim rez1 As Single, rez2 As Single, rez3 As Single
Dvo1 = Text1
Dvo2 = Text2
For i = 1 To Len(Dvo1)
rez1 = rez1 + Mid(Dvo1, i, 1) * (2 ^ (Len(Dvo1) - i))
Next i
For i = 1 To Len(Dvo2)
rez2 = rez2 + Mid(Dvo2, i, 1) * (2 ^ (Len(Dvo2) - i))
Next i
If Option4 = True Then
rez3 = rez1 + rez2
End If
If Option5 = True Then
rez3 = rez1 - rez2
End If
If Option6 = True Then
rez3 = rez1 * rez2
End If
If Option7 = True Then
rez3 = rez1 / rez2
End If
 
Dim a As Single, rez() As Single, rezultat() As Single, sss As String
a = rez3
k = 1
Label1:
ReDim Preserve rez(1 To k) As Single
c = a \ 2
x = c * 2
rez(k) = a - x
a = c
If a = 0 Then GoTo Label2
k = k + 1
If a = 1 Then
ReDim Preserve rez(1 To k) As Single
rez(k) = 1
GoTo Label2
End If
GoTo Label1
Label2:
ReDim Preserve rezultat(1 To k) As Single
For i = 1 To k
rezultat(k + 1 - i) = rez(i)
Next i
For i = 1 To k
sss = sss & rezultat(i)
Next i
Label3 = "Результат: " & sss
 
End Sub
 ‘Кнопка выхода
Private Sub Command4_Click()
If MsgBox("Вы желаете выйти?;)", vbOKCancel, "exit") = vbOK Then
Unload Form1
Exit Sub
End If
End Sub
 ‘Дальше процедуры обрабатывающие комбинации нажатых кнопок и активных полей
Private Sub Option1_Click()
If Option1 = True Then
Command2.Enabled = False
Command1.Enabled = True
Command3.Enabled = False
Text1.Enabled = True
Text2.Enabled = False
Frame1.Enabled = False
End If
End Sub
Private Sub Option2_Click()
If Option2 = True Then
Command2.Enabled = True
Command1.Enabled = False
Command3.Enabled = False
Text1.Enabled = True
Text2.Enabled = False
Frame1.Enabled = False
End If
End Sub
 
Private Sub Option3_Click()
If Option3 = True Then
Command2.Enabled = False
Command1.Enabled = False
Command3.Enabled = True
Text1.Enabled = True
Text2.Enabled = True
Frame1.Enabled = True
Option4 = True
End If
End Sub

@Prelest) · 24.03.2010, 15:49 **[ТС]**

Спасибо за комментарии. Не получилась у вас для дробной части программку сделать?

@Prelest) · 26.03.2010, 20:30 **[ТС]**

Плиииз! Если не очень сложно, сделайте программу с дробной частью. В этом главная суть задания.

@YuraAAA · 27.03.2010, 04:32

Это ппц) сами наверное не разберётесь даже) но работает ))

Visual Basic
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
Dim Char As Single
Private Sub Command1_Click()
If IsNumeric(Text1) = False Then
MsgBox ("Введите число")
Exit Sub
End If
If Fix(text1) <> Text1 Then GoTo LabelDrob
Dim a As Single, rez() As Single, rezult() As Single, sss As String
a = Text1
k = 1
Check1.Value = 0
Label1:
ReDim Preserve rez(1 To k) As Single
c = a \ 2
x = c * 2
rez(k) = a - x
a = c
If a = 0 Then GoTo Label2
k = k + 1
If a = 1 Then
ReDim Preserve rez(1 To k) As Single
rez(k) = 1
GoTo Label2
End If
GoTo Label1
Label2:
ReDim Preserve rezult(1 To k) As Single
For i = 1 To k
rezult(k + 1 - i) = rez(i)
Next i
For i = 1 To k
sss = sss & rezult(i)
Next i
Label3 = "Результат: " & sss
Exit Sub
'А если число дробное то ппц))
LabelDrob:
Check1.Value = 1
Dim aa As Single
a = Fix(Text1)
k = 1
Label11:
ReDim Preserve rez(1 To k) As Single
c = a \ 2
x = c * 2
rez(k) = a - x
a = c
If a = 0 Then GoTo Label22
k = k + 1
If a = 1 Then
ReDim Preserve rez(1 To k) As Single
rez(k) = 1
GoTo Label22
End If
GoTo Label11
Label22:
ReDim Preserve rezult(1 To k) As Single
For i = 1 To k
rezult(k + 1 - i) = rez(i)
Next i
For i = 1 To k
sss = sss & rezult(i)
Next i
aa = Text1 - (Text1 \ 1)
e = 0
k2 = 0
Dim rezult2() As Single
Do While e <= 8
aa = aa * 2
k2 = k2 + 1
ReDim Preserve rezult2(1 To k2) As Single
rezult2(k2) = Fix(aa)
aa = Round(aa - Fix(aa), 3)
e = e + 1
Loop
lll = ""
For i = 1 To k2
lll = lll & rezult2(i)
Next i
Label3 = "Результат: " & sss & "," & lll
End Sub
Private Sub Command2_Click()
If IsNumeric(Text1) = False Then
MsgBox ("Введите число ")
Exit Sub
End If
If Fix(Text1) <> Text1 Then GoTo LabelDrob
Check2.Value = 0
For i = 1 To Len(Text1)
Char = Mid(Text1, i, 1)
If Char <> "0" Then
If Char <> "1" Then
MsgBox ("Значение должно содержать только 0 или 1")
Exit Sub
End If
End If
Next i
Dim Dvo As String, rezult As Single
Dvo = Text1
For i = 1 To Len(Dvo)
rezult = rezult + Mid(Dvo, i, 1) * (2 ^ (Len(Dvo) - i))
Next i
Label3 = "Результат: " & rezult
Exit Sub
'А если число дробное то ппц))
LabelDrob:
Dim rezult2 As Single
Dim cc As Byte
Dim char2 As Variant
Check2.Value = 0
tra = ""
tra = Fix(Text1)
For i = 1 To Len(tra)
Char = Mid(tra, i, 1)
If Char <> "0" Then
If Char <> "1" Then
MsgBox ("Значение должно содержать только 0 или 1")
Exit Sub
End If
End If
Next i
Dvo = tra
For i = 1 To Len(Dvo)
rezult = rezult + Mid(Dvo, i, 1) * (2 ^ (Len(Dvo) - i))
Next i
For i = 1 To Len(Text1)
char2 = Mid(Text1, i, 1)
If char2 <> "0" Then
If char2 <> "1" Then
If char2 <> "," Then
MsgBox ("Значение должно содержать только 0 или 11")
Exit Sub
End If
End If
End If
Next i
klk = 0
Check2.Value = 1
For i = 1 To Len(Text1)
If Mid(Text1, i, 1) = "," Then
Exit For
Else
klk = klk + 1
End If
Next i
cc = 0
For i = klk + 2 To Len(Text1)
cc = cc + 1
rezult2 = rezult2 + Mid(Text1, i, 1) * (2 ^ ((-1) * cc))
Next i
Label3 = "Результат : " & rezult + rezult2
End Sub
Private Sub Command3_Click()
If IsNumeric(Text1) = False Then
MsgBox ("Введите число ")
Exit Sub
End If
If IsNumeric(Text2) = False Then
MsgBox ("Введите число")
Exit Sub
End If
 
For i = 1 To Len(Text1)
Char = Mid(Text1, i, 1)
If Char <> "0" Then
If Char <> "1" Then
MsgBox ("Значение должно содержать только 0 или 1")
Exit Sub
End If
End If
Next i
For i = 1 To Len(Text2)
Char = Mid(Text2, i, 1)
If Char <> "0" Then
If Char <> "1" Then
MsgBox ("Значение должно содержать только 0 или 1")
Exit Sub
End If
End If
Next i
Dim Dvo1 As String, Dvo2 As String, rezult As Single
Dim rez1 As Single, rez2 As Single, rez3 As Single
Dvo1 = Text1
Dvo2 = Text2
For i = 1 To Len(Dvo1)
rez1 = rez1 + Mid(Dvo1, i, 1) * (2 ^ (Len(Dvo1) - i))
Next i
For i = 1 To Len(Dvo2)
rez2 = rez2 + Mid(Dvo2, i, 1) * (2 ^ (Len(Dvo2) - i))
Next i
If Option4 = True Then
rez3 = rez1 + rez2
End If
If Option5 = True Then
rez3 = rez1 - rez2
End If
If Option6 = True Then
rez3 = rez1 * rez2
End If
If Option7 = True Then
rez3 = rez1 / rez2
End If
Dim a As Single, rez() As Single, rezultat() As Single, sss As String
a = rez3
k = 1
Label1:
ReDim Preserve rez(1 To k) As Single
c = a \ 2
x = c * 2
rez(k) = a - x
a = c
If a = 0 Then GoTo Label2
k = k + 1
If a = 1 Then
ReDim Preserve rez(1 To k) As Single
rez(k) = 1
GoTo Label2
End If
GoTo Label1
Label2:
ReDim Preserve rezultat(1 To k) As Single
For i = 1 To k
rezultat(k + 1 - i) = rez(i)
Next i
For i = 1 To k
sss = sss & rezultat(i)
Next i
Label3 = "Результат: " & sss
End Sub
Private Sub Command4_Click()
If MsgBox("Вы хотите выйти?;)", vbOKCancel, "exit") = vbOK Then
Unload Form1
Exit Sub
End If
End Sub
Private Sub Option1_Click()
If Option1 = True Then
Command2.Enabled = False
Command1.Enabled = True
Command3.Enabled = False
Text1.Enabled = True
Text2.Enabled = False
Frame1.Enabled = False
End If
End Sub
Private Sub Option2_Click()
If Option2 = True Then
Command2.Enabled = True
Command1.Enabled = False
Command3.Enabled = False
Text1.Enabled = True
Text2.Enabled = False
Frame1.Enabled = False
End If
End Sub
Private Sub Option3_Click()
If Option3 = True Then
Command2.Enabled = False
Command1.Enabled = False
Command3.Enabled = True
Text1.Enabled = True
Text2.Enabled = True
Frame1.Enabled = True
Option4 = True
End If
End Sub

Добавлено через 54 секунды
Код конечно не оптимизирован,кое-что можно убрать,но мне просто лень это делать

и так запарился это писать )

@YuraAAA · 27.03.2010, 04:34

Вот exe шник

@Prelest) · 27.03.2010, 16:09 **[ТС]**

Спасибо вам огромное!!!

Сегодня сдала)))

@YuraAAA · 27.03.2010, 16:18

Пожалуйста

@Prelest) · 29.03.2010, 17:23 **[ТС]**

Оказывается, препод мне только половину задания отметил. Надо доделать, чтобы программа арифметические действия с дробными двоичными числами выполняла

@YuraAAA · 29.03.2010, 18:50

Значит будем менять третью процедуру.

@Prelest) · 29.03.2010, 20:45 **[ТС]**

Спасибо

. Постараюсь завтра сдать)))

Новые блоги и статьи Все статьи Все блоги /
http://iceja.net/ математические сервисы iceja 20.01.2026 Обновила свой сайт http:/ / iceja. net/ , приделала Fast Fourier Transform экстраполяцию сигналов. Однако предсказывает далеко не каждый сигнал (см ограничения http:/ / iceja. net/ fourier/ docs ). Также. . .	http://iceja.net/ сервер решения полиномов iceja 18.01.2026 Выкатила http:/ / iceja. net/ сервер решения полиномов (находит действительные корни полиномов методом Штурма). На сайте документация по API, но скажу прямо VPS слабенький и 200 000 полиномов. . .	Расчёт переходных процессов в цепи постоянного тока igorrr37 16.01.2026 / * Дана цепь постоянного тока с R, L, C, k(ключ), U, E, J. Программа составляет систему уравнений по 1 и 2 законам Кирхгофа, решает её и находит переходные токи и напряжения на элементах схемы. . . .	Восстановить юзерскрипты Greasemonkey из бэкапа браузера damix 15.01.2026 Если восстановить из бэкапа профиль Firefox после переустановки винды, то список юзерскриптов в Greasemonkey будет пустым. Но восстановить их можно так. Для этого понадобится консольная утилита. . .
Сукцессия микоризы: основная теория в виде двух уравнений. anaschu 11.01.2026 https:/ / rutube. ru/ video/ 7a537f578d808e67a3c6fd818a44a5c4/	WordPad для Windows 11 Jel 10.01.2026 WordPad для Windows 11 — это приложение, которое восстанавливает классический текстовый редактор WordPad в операционной системе Windows 11. После того как Microsoft исключила WordPad из. . .	Classic Notepad for Windows 11 Jel 10.01.2026 Old Classic Notepad for Windows 11 Приложение для Windows 11, позволяющее пользователям вернуть классическую версию текстового редактора «Блокнот» из Windows 10. Программа предоставляет более. . .	Почему дизайн решает? Neotwalker 09.01.2026 В современном мире, где конкуренция за внимание потребителя достигла пика, дизайн становится мощным инструментом для успеха бренда. Это не просто красивый внешний вид продукта или сайта — это. . .

@Prelest) 2 / 2 / 0 Регистрация: 22.03.2010 Сообщений: 141

	Создать арифмометр, который переводит рациональные числа из двоичной системы в десятичную и обратно 22.03.2010, 20:41. Показов 8301. Ответов 22 Метки нет (Все метки) Создать арифмометр (почти калькулятор), который переводит рациональные числа (а значит - и дробные) из двоичной системы в десятичную и обратно. Кроме того арифмометр должен складывать, вычитать, умножать и делить числа в ДВОИЧНОЙ системе счисления. Программу можно писать на любом из языков: VB, Delphi, TP(если на нём возможно). В принципе - вообще на любом языке, боюсь просто, что его у меня может не быть. Кроме того необязательно переводить в двоичную систему, можно и в восьмиричную. Заранее всем спасибо, кто хочет помочь. 0

@Prelest) 2 / 2 / 0 Регистрация: 22.03.2010 Сообщений: 141
	23.03.2010, 16:11 [ТС]
	Спасибо большое!!!! Ехешник работает так, как надо. Ещё не проверяла саму программу, дома VB нет, завтра в универе посмотрю. Но спасибо вам огромное!!!!! Впервые обращаюсь с такими просьбами. Даже не вериться, что здесь действительно помогают))) 0

@YuraAAA 1605 / 1337 / 291 Регистрация: 25.10.2009 Сообщений: 3,487 Записей в блоге: 2
	23.03.2010, 16:16
	Всегда пожалуйста Вот exe-шник с проверками на введённые данные ) Вот только дробные у меня не считает...пока что ) 0

@Prelest) 2 / 2 / 0 Регистрация: 22.03.2010 Сообщений: 141
	23.03.2010, 16:34 [ТС]
	Точно! Я на радости такой совсем забыла про дробную часть. Ещё не могли бы вы написать комментарии к основным частям программы? Я в программировании - ноль. 0

@YuraAAA 1605 / 1337 / 291 Регистрация: 25.10.2009 Сообщений: 3,487 Записей в блоге: 2
	23.03.2010, 16:42
	Как будет время-напишу,и попробую сделать дробную часть.Постараюсь сегодня 0

@Prelest) 2 / 2 / 0 Регистрация: 22.03.2010 Сообщений: 141
	23.03.2010, 16:45 [ТС]
	Спасибо 0

@Prelest) 2 / 2 / 0 Регистрация: 22.03.2010 Сообщений: 141
	24.03.2010, 15:49 [ТС]
	Спасибо за комментарии. Не получилась у вас для дробной части программку сделать? 0

@Prelest) 2 / 2 / 0 Регистрация: 22.03.2010 Сообщений: 141
	26.03.2010, 20:30 [ТС]
	Плиииз! Если не очень сложно, сделайте программу с дробной частью. В этом главная суть задания. 0

@Prelest) 2 / 2 / 0 Регистрация: 22.03.2010 Сообщений: 141
	27.03.2010, 16:09 [ТС]
	Спасибо вам огромное!!! Сегодня сдала))) 0

@YuraAAA 1605 / 1337 / 291 Регистрация: 25.10.2009 Сообщений: 3,487 Записей в блоге: 2
	27.03.2010, 16:18
	Пожалуйста 0

@Prelest) 2 / 2 / 0 Регистрация: 22.03.2010 Сообщений: 141
	29.03.2010, 17:23 [ТС]
	Оказывается, препод мне только половину задания отметил. Надо доделать, чтобы программа арифметические действия с дробными двоичными числами выполняла 0

@Prelest) 2 / 2 / 0 Регистрация: 22.03.2010 Сообщений: 141
	29.03.2010, 20:45 [ТС]
	Спасибо. Постараюсь завтра сдать))) 0