Обсуждение работы проекта "Калькулятор со скобками и корнем"

@Антихакер32 · Регистрация: 06.01.2014

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

Калькулятор со скобками и корнем

Вот так, легко и просто, за один вечер собрал эту штуку
надеюсь комунибудь придет идея сделать эту программу лучше

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
Option Explicit
'
'Калькулятор на VB
'Простенькая реализация калькулятора ... © Антихакер32™
'
Dim X&, Y&
Const nX = 6, nY = 4, p = " "
Dim Matrix32(nX - 1, nY - 1) As CommandButton
Dim WithEvents cmm As CommandButton
Dim WithEvents cmb As ComboBox
Dim WithEvents tmr As Timer
Dim pos&
Private Function RG(Expression$)
    Const s = "+|-|*|/|^|Mod"
    Dim j$(), f&
    j = Split(s, "|")
    RG = Replace(Expression, p, "")
    For f = 0 To UBound(j)
        RG = Replace(RG, j(f), p & j(f) & p)
    Next
End Function
Private Function Calc(ByVal Expression$)
    Dim s$, j$(), j1$(), f&, f1&, n&, le&
    Expression = LCase(RG(Expression))
    'Разбитие на скобки
    j = Split(Expression, "(")
    If UBound(j) Then
        For f1 = UBound(j) To 0 Step -1
            j1 = Split(j(f1), ")"): j1(0) = Calc(j1(0))
            If f1 = 0 Then Expression = j(f1): Exit For
            j(f1 - 1) = j(f1 - 1) & RG(Join(j1))
        Next
    End If: le = Len(Expression)
    Do: n = InStr(n + 1, Expression, "sqr"): s = ""
        If n Then
            For f = n + 3 To le
                If Mid$(Expression, f, 1) = p Then
                    Expression = Left(Expression, n - 1) & Sqr(s) & Mid$(Expression, f): Exit For
                ElseIf f = le Then Expression = Left(Expression, n - 1) & Sqr(s & Mid$(Expression, f, 1)): Exit For
                End If: s = s & Mid$(Expression, f, 1)
    Next: End If: Loop While n
    Do: n = InStr(n + 1, Expression, "fix"): s = ""
        If n Then
            For f = n + 3 To le
                If Mid$(Expression, f, 1) = p Then
                    Expression = Left(Expression, n - 1) & Fix(s) & Mid$(Expression, f): Exit For
                ElseIf f = le Then Expression = Left(Expression, n - 1) & Fix(s & Mid$(Expression, f, 1)): Exit For
                End If: s = s & Mid$(Expression, f, 1)
    Next: End If: Loop While n
    Calc = Expression
    Do While InStr(1, Calc, "*") Or InStr(1, Calc, "/") Or InStr(1, Calc, "^") Or InStr(1, Calc, "mod")
        j = Split(Calc)
        For f = 1 To UBound(j)
            Select Case j(f)
            Case "^": j(f - 1) = j(f - 1) ^ j(f + 1): Exit For
            Case "*": j(f - 1) = j(f - 1) * j(f + 1): Exit For
            Case "/": j(f - 1) = j(f - 1) / j(f + 1): Exit For
            Case "mod": j(f - 1) = j(f - 1) Mod j(f + 1): Exit For
            End Select
        Next:  j(f) = "": j(f + 1) = "": Calc = RG(Join(j))
    Loop
    Do While InStr(1, Calc, "+") Or InStr(1, Calc, "-")
        j = Split(Calc)
        For f = 1 To UBound(j)
            Select Case j(f)
            Case "+": j(f - 1) = Val(j(f - 1)) + j(f + 1): Exit For
            Case "-": j(f - 1) = j(f - 1) - j(f + 1): Exit For
            End Select
        Next
        j(f) = "": j(f + 1) = "": Calc = RG(Join(j))
    Loop
End Function
Private Sub cmm_Click()
    Dim s$
    cmb.SetFocus
    Select Case cmm.Caption
    Case "Fix", "Sqr": s = p & cmm.Caption & "("
    Case "="
        s = Calc(cmb)
        cmb.AddItem cmb & " = " & s
        cmb = s: pos = Len(cmb): cmb.SelStart = pos
        Exit Sub
    Case "CE": cmb.Text = 0: pos = 1: cmb.SelStart = pos: Exit Sub
    Case "x^y": s = p & "^" & p
    Case "+", "-", "*", "/", "Mod": s = p & cmm.Caption & p
    Case Else: s = cmm.Caption
    End Select
    If Left$(cmb, 1) = "0" Then cmb = Mid$(cmb, 2)
    cmb.SelStart = pos
    cmb.SelText = s
    pos = pos + Len(s)
End Sub
Private Sub Form_Load()
    Dim o
    Const sL = 100, sz = 500, sT = sz + sL * 2
    Dim j$(), s$, i&, h&
    s = s & "7 8 9 = CE Sqr "
    s = s & "4 5 6 ( ) x^y "
    s = s & "1 2 3 + - Fix "
    s = s & "0 , % * / Mod "
    j = Split(s)
    On Error Resume Next
    For Y = 0 To nY - 1: For X = 0 To nX - 1
            Set Matrix32(X, Y) = Controls.Add("vb.CommandButton", "cmm_" & X & Y)
            With Matrix32(X, Y)
                Select Case X
                Case 3, 4: .Move sL * 2 + X * sz, sT + Y * sz, sz, sz: .Visible = 1
                Case 5: .Move sL * 3 + X * sz, sT + Y * sz, sz * 1.5, sz: .Visible = 1
                Case Else: .Move sL + X * sz, sT + Y * sz, sz, sz
                End Select:  .FontSize = 10: .FontBold = 1: .Caption = j(i): i = i + 1: .Visible = 1
            End With
    Next: Next
    Set cmb = Controls.Add("vb.ComboBox", "cmb")
    With cmb
        .FontSize = 10: h = .Height
        .Move sL, Matrix32(0, 0).Top - h - sL, (Matrix32(nX - 1, 0).Left + Matrix32(nX - 1, 0).Width) - sL: .Visible = 1
        .Text = 0
        Me.Width = .Width + sL * 4
    End With
    Set o = Controls("cmm_" & X - 1 & Y - 1)
    Me.Height = o.Top + o.Height + sz + sL * 2
    Me.Caption = "Калькулятор VB ... © Антихакер32™"
    Set tmr = Controls.Add("vb.Timer", "tmr"): tmr.Interval = 10
End Sub
Private Sub tmr_Timer()
    Static OldName$
    If OldName <> ActiveControl.Name And ActiveControl.Name Like "cmm_##" Then
        Set cmm = ActiveControl
    End If: OldName = ActiveControl.Name
End Sub
Private Sub cmb_Validate(Cancel As Boolean): pos = cmb.SelStart: End Sub

@The trick · 11.07.2014, 22:00

Сообщение от Антихакер32

вы это придумали
найдите это и покажите где вы это нашли

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

Добавлено через 24 минуты
Анатолий, продвинь меня. я тебе завидую, вспомни прошлый год
именно многие мои движения привели тебя к тому, чегоя и добивался
и именно я первый рьяно в этом старался

Добавлено через 2 минуты
И ты меня забыл ?.....

Добавлено через 19 минут
Что за хэ, я надеюсь ва эти файлы не вынесли

Добавлено через 16 минут
Создайте ссылку, прежде чем говорить

где ссылка на наш проовайдер ?

Сообщение от Антихакер32

а насчет готовых кодов, вот я переадрисую просьбу моего друга Dragokas вам

Я не вижу связи с моим сообщением.

@Антихакер32 · 11.07.2014, 22:02 **[ТС]**

Pro_grammer помог, указал на ошибки и я их исправил
и это я не вижу никакой связи с вашими постами

@The trick · 11.07.2014, 22:03

Сообщение от Антихакер32

Pro_grammer помог, указал на ошибки и я их исправил все!

Где? Ты отвечай пожалуйста последовательно на посты. Я не уловил связи на в прошлом посте не в этом.

@Антихакер32 · 12.07.2014, 00:09 **[ТС]**

Сообщение от Dragokas

Попробовал просто ввести несколько вариантов операций.
Например -3+2

Исправил я работу с отрицательным числом
всеголиш только нужно-было исключить минус в этой функции

Visual Basic
1
2
3
4
5
6
7
8
9
Private Function RG(Expression$)
    Const s = "+|*|/|^|Mod"
    Dim j$(), f&
    j = Split(s, "|")
    RG = Replace(Expression, p, "")
    For f = 0 To UBound(j)
        RG = Replace(RG, j(f), p & j(f) & p)
    Next
End Function

Добавлено через 17 минут
И еще пару исправлений сделал
в обработчике будет читаться так.. -3 + -2

если минус между числами то так: -3 - 2

Добавлено через 2 минуты
это делается чтоб пробел был там где надо..
я бы и код выложил целиком, но лучше я это сделаю в другом месте

Dragokas · 12.07.2014, 01:21

Надо дописать в шапку темы, что
"Для доведения кода в рабочее состояние в порядке обсуждения создайте новую тему".

Сообщение от Антихакер32

а насчет готовых кодов, вот я переадрисую просьбу моего друга Dragokas вам
Сообщение от Dragokas
отыскать нерабочие примеры, найти человека, который их написал и попросить
исправить + помочь ему их исправить
Добавлено через 6 минут
вобщем это пустое все..
неконструктивный разговор, и неадекватная реакция одного из участников
надеюсь очень скоро эти посты ктонибудь снесет

Быстро ты переводишь стрелки, когда просьба о помощи направляется именно к тебе.

Я приведу свой пример: я за сегодня помогал на нескольких форумах.
В итоге то, что хотелось написать от себя - не успел. И ничего нового практически не узнал.
Но это мои проблемы.

Но философия такая: глубо говорить, что тебе не помогают.

Сообщение от The trick

за то что твой код протестировали и указали что он содержит ошибки

Потраченное время за тестирование твоего кода как минимум 3 человека.
И ты говоришь, что тебе никто не помогает.

Сообщение от Антихакер32

это делается чтоб пробел был там где надо..
я бы и код выложил целиком, но лучше я это сделаю в другом месте

Если это не последний вариант исправлений всех ошибок,
то лучше создать отдельную тему. Раньше (и по правилам) это была постоянная практика.

@Антихакер32 · 12.07.2014, 01:44 **[ТС]**

Сообщение от Dragokas

Потраченное время за тестирование твоего кода как минимум 3 человека

Надеюсь кое кто не надорвался чтоб просто скопировать и запустить код

Вариант без минусов

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
Option Explicit
Dim X&, Y&
Const nX = 6, nY = 4, p = " "
Dim Matrix32(nX - 1, nY - 1) As CommandButton
Dim WithEvents cmm As CommandButton
Dim WithEvents cmb As ComboBox
Dim WithEvents tmr As Timer
Dim pos&
 
Private Function RG(Expression$)
    Const s = "+|*|/|^|Mod"
    Dim j$(), f&
    j = Split(s, "|")
    RG = Replace(Expression, p, "")
    For f = 0 To UBound(j)
        RG = Replace(RG, j(f), p & j(f) & p)
    Next
    RG = Replace(RG, "-", p & "-"):  j = Split(RG)
    For f = 1 To UBound(j)
        If IsNumeric(j(f - 1)) And IsNumeric(j(f)) Then
            If j(f) < 0 Then j(f) = "- " & Abs(j(f))
        End If
    Next: RG = Trim$(Join(j))
End Function
 
 
Private Function Calc(ByVal Expression$)
    Dim s$, j$(), j1$(), f&, f1&, n&, le&
    Expression = LCase(RG(Expression))
    'Разбитие на скобки
    j = Split(Expression, "(")
    If UBound(j) Then
        For f1 = UBound(j) To 0 Step -1
            j1 = Split(j(f1), ")"): j1(0) = Calc(j1(0))
            If f1 = 0 Then Expression = j(f1): Exit For
            j(f1 - 1) = j(f1 - 1) & RG(Join(j1))
        Next
    End If: le = Len(Expression)
    Do: n = InStr(n + 1, Expression, "sqr"): s = ""
        If n Then
            For f = n + 3 To le
                If Mid$(Expression, f, 1) = p Then
                    Expression = Left(Expression, n - 1) & Sqr(s) & Mid$(Expression, f): Exit For
                ElseIf f = le Then Expression = Left(Expression, n - 1) & Sqr(s & Mid$(Expression, f, 1)): Exit For
                End If: s = s & Mid$(Expression, f, 1)
    Next: End If: Loop While n
    Do: n = InStr(n + 1, Expression, "fix"): s = ""
        If n Then
            For f = n + 3 To le
                If Mid$(Expression, f, 1) = p Then
                    Expression = Left(Expression, n - 1) & Fix(s) & Mid$(Expression, f): Exit For
                ElseIf f = le Then Expression = Left(Expression, n - 1) & Fix(s & Mid$(Expression, f, 1)): Exit For
                End If: s = s & Mid$(Expression, f, 1)
    Next: End If: Loop While n
    Calc = Expression
    On Error Resume Next
    Do While InStr(1, Calc, "*") Or InStr(1, Calc, "/") Or InStr(1, Calc, "^") Or InStr(1, Calc, "mod")
        j = Split(Calc)
        For f = 1 To UBound(j)
            Select Case j(f)
            Case "^": j(f - 1) = j(f - 1) ^ j(f + 1): Exit For
            Case "*": j(f - 1) = j(f - 1) * j(f + 1): Exit For
            Case "/": j(f - 1) = j(f - 1) / j(f + 1): Exit For
            Case "mod": j(f - 1) = j(f - 1) Mod j(f + 1): Exit For
            End Select
        Next:  j(f) = "": j(f + 1) = "": Calc = RG(Join(j))
    Loop
    Do While InStr(1, Calc, "+") Or InStr(1, Calc, "-")
        j = Split(Calc)
        For f = 1 To UBound(j)
            Select Case j(f)
            Case "+": j(f - 1) = Val(j(f - 1)) + Val(j(f + 1)): Exit For
            Case "-": j(f - 1) = j(f - 1) - j(f + 1): Exit For
            End Select
        Next
        j(f) = "": j(f + 1) = "": Calc = RG(Join(j))
        If Err Then Exit Do
    Loop
End Function
 
Private Sub cmb_Validate(Cancel As Boolean)
    pos = cmb.SelStart
End Sub
 
Private Sub cmm_Click()
    Dim s$
    cmb.SetFocus
    Select Case cmm.Caption
    Case "Fix", "Sqr": s = p & cmm.Caption & "("
    Case "="
        s = Calc(cmb)
        cmb.AddItem cmb & " = " & s
        cmb = s: pos = Len(cmb): cmb.SelStart = pos
        Exit Sub
    Case "CE": cmb.Text = 0: pos = 1: cmb.SelStart = pos: Exit Sub
    Case "x^y": s = p & "^" & p
    Case "+", "-", "*", "/", "Mod": s = p & cmm.Caption & p
    Case Else: s = cmm.Caption
    End Select
    If Left$(cmb, 1) = "0" Then cmb = Mid$(cmb, 2)
    cmb.SelStart = pos
    cmb.SelText = s
    pos = pos + Len(s)
End Sub
 
 
Private Sub Form_Load()
    Dim v
    Const sL = 100, sz = 500, sT = sz + sL * 2
    Dim j$(), s$, i&, h&
    s = s & "7 8 9 = CE Sqr "
    s = s & "4 5 6 ( ) x^y "
    s = s & "1 2 3 + - Fix "
    s = s & "0 , % * / Mod "
    j = Split(s)
    On Error Resume Next
    For Y = 0 To nY - 1: For X = 0 To nX - 1
            Set Matrix32(X, Y) = Controls.Add("vb.CommandButton", "cmm_" & X & Y)
            With Matrix32(X, Y)
                Select Case X
                Case 3, 4: .Move sL * 2 + X * sz, sT + Y * sz, sz, sz: .Visible = 1
                Case 5: .Move sL * 3 + X * sz, sT + Y * sz, sz * 1.5, sz: .Visible = 1
                Case Else: .Move sL + X * sz, sT + Y * sz, sz, sz
                End Select:  .FontSize = 10: .FontBold = 1: .Caption = j(i): i = i + 1: .Visible = 1
            End With
    Next: Next
    Set cmb = Controls.Add("vb.ComboBox", "cmb")
    With cmb
        .FontSize = 10: h = .Height
        .Move sL, Matrix32(0, 0).Top - h - sL, (Matrix32(nX - 1, 0).Left + Matrix32(nX - 1, 0).Width) - sL: .Visible = 1
        .Text = 0
    End With
    Set tmr = Controls.Add("vb.Timer", "tmr")
    tmr.Interval = 10
End Sub
 
Private Sub tmr_Timer()
    Static OldName$
    If OldName <> ActiveControl.Name And ActiveControl.Name Like "cmm_##" Then
        Set cmm = ActiveControl
    End If
    OldName = ActiveControl.Name
End Sub

@The trick · 12.07.2014, 01:57

Сообщение от Антихакер32

Надеюсь кое кто не надорвался чтоб просто скопировать и запустить код

Незачто.

Сообщение от Антихакер32

Вариант без минусов

Dragokas · 12.07.2014, 02:17

Антихакер32, пиши ИСЧО

@Антихакер32 · 12.07.2014, 17:09 **[ТС]**

Исправил, !

В этом коде я предусмотрел абсолютно все
переплюнул через себя и свою гордость и сделал
правилно работающую версию, я этим самым ничего нихочу доказать
только из уважения к Dragokas, и то что он сказал:
его стараниям, и тому что он отдает безвозмездно свои знания людям

Сообщение от Dragokas

Я приведу свой пример: я за сегодня помогал на нескольких форумах.
В итоге то, что хотелось написать от себя - не успел. И ничего нового практически не узнал.
Но это мои проблемы.

Итак:
Процент работает
Минус работает
Скобки работают
Прошлый результат работает
Защита от дурака имеется
Критические ошибки отображаются

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
Option Explicit
'
'Калькулятор на VB ... © Антихакер32™ ...2014
'
Const nX = 6, nY = 4, p = " ", Promt1 = "<Деление на 0>", Promt2 = "<Переполнение>"
Dim Matrix32(nX - 1, nY - 1) As CommandButton
Dim WithEvents cmm As CommandButton
Dim WithEvents cmb As ComboBox
Dim WithEvents tmr As Timer
Dim pos&, dic As Object, X&, Y&
Private Function RG(Expression$)
    Const s = "+|*|/|^|MOD"
    Dim j$(), f&
    RG = UCase(Replace(Expression, p, "")): j = Split(s, "|")
    For f = 0 To UBound(j)
        RG = Replace(RG, j(f), p & j(f) & p)
    Next
    RG = Replace(RG, "-", p & "-"):  j = Split(RG)
    For f = 1 To UBound(j)
        If IsNumeric(j(f - 1)) And IsNumeric(j(f)) Then
            If j(f) < 0 Then j(f) = "- " & Abs(j(f))
        End If
    Next: RG = Trim$(Join(j))
    RG = Replace(RG, "E + ", "E+")
    RG = Replace(RG, "E -", "E-")
    RG = Replace(RG, p & p, p)
End Function
Private Function Calc(ByVal Expression$)
    Dim s$, j$(), j1$(), f&, f1&, n&, vEach, Le&
    f = InStr(1, Expression, "<")
    If f Then Calc = Mid$(Expression, f): Calc = Left$(Calc, InStr(1, Calc, ">")): Exit Function
    Expression = RG(Expression)
    'Разбитие на скобки
    j = Split(Expression, "(")
    On Error Resume Next
    If UBound(j) Then
        For f1 = UBound(j) To 0 Step -1
            j1 = Split(j(f1), ")"): j1(0) = Calc(j1(0)): If f1 = 0 Then Expression = j(f1): Exit For
            j(f1 - 1) = j(f1 - 1) & RG(Join(j1))
    Next: End If
    For Each vEach In Array("SQR", "FIX")
        j = Split(Expression): Le = Len(vEach)
        For f = 0 To UBound(j)
            If Right$(j(f), 1) = "%" Then j(f) = Val(j(f)) / 100
            Select Case Left$(j(f), Le)
            Case "SQR": j(f) = Sqr(Mid(j(f), Le + 1))
            Case "FIX": j(f) = Fix(Mid(j(f), Le + 1))
            End Select
    Next: Expression = Join(j): Next: Calc = RG(Expression)
    Do While InStr(1, Calc, "*") Or InStr(1, Calc, "/") Or InStr(1, Calc, "^") Or InStr(1, Calc, "MOD")
        j = Split(Calc)
        For f = 1 To UBound(j)
            Select Case j(f)
            Case "^": j(f - 1) = CDbl(j(f - 1)) ^ CDbl(j(f + 1)): Exit For
            Case "*": j(f - 1) = CDbl(j(f - 1)) * CDbl(j(f + 1)): Exit For
            Case "/": If j(f + 1) = 0 Then Calc = Promt1: Exit Function
                j(f - 1) = CDbl(j(f - 1)) / CDbl(j(f + 1)): Exit For
            Case "MOD": j(f - 1) = CDbl(j(f - 1)) Mod CDbl(j(f + 1)): Exit For
            End Select
        Next
        j(f) = "": j(f + 1) = "": Calc = RG(Join(j))
        If Err.Number = 9 Then
            Calc = RG(0 & Expression): Err.Clear
        ElseIf Err.Number = 6 Then Calc = Promt2:  Err.Clear: Exit Function
        ElseIf Err Then Err.Clear: Exit Do
        End If
    Loop: j = IIf(Left(Calc, 1) Like "+", Split("0 " & Calc), Split(Calc))
    For f = 1 To UBound(j) 'Последовательное сложение или вычитанее
        Select Case j(f)
        Case "+": j(0) = CDbl(j(0)) + CDbl(j(f + 1)): f = f + 1
        Case "-": j(0) = CDbl(j(0)) - CDbl(j(f + 1)): f = f + 1
        End Select: If Err.Number = 6 Then Calc = Promt2: Exit Function
    Next: j(f) = "": j(f + 1) = "": Calc = RG(j(0))
End Function
 
Private Sub cmm_Click()
    Dim s$, Op As Boolean: Static Result$, f&, OldOp As Boolean, b As Boolean
    cmb.SetFocus
    If Len(Result) Then
        If IsNumeric(cmm.Caption) Then cmb = ""
        Select Case cmm.Caption
        Case "Sqr", "Fix": cmb = ""
        End Select
    End If: b = OldOp Or cmb = "0" Or cmb = ""
    Select Case cmm.Caption
    Case "="
        f = InStr(1, cmb, "="): If f Then cmb = Left$(cmb, f - 1)
        Result = Calc(cmb): cmb = Trim$(Replace(cmb, p & p, p))
        s = cmb & " = " & Result: cmb = Result
        If Not dic.Exists(s) Then dic.Add s, 0: cmb.AddItem s
        cmb = Result: pos = Len(cmb): cmb.SelStart = pos: OldOp = 0: Op = 0: GoTo EndSub
    Case "CE": cmb.Text = 0: pos = 1: cmb.SelStart = pos: OldOp = 0: Op = 0: GoTo EndSub
    Case "x^y": s = p & "^" & p: Op = 1
    Case "-" 'Проверка на второй минус
        For f = Len(cmb) To 1 Step -1
            s = Mid$(cmb, f, 1): If IsNumeric(s) Then Exit For
            If s = "-" Then GoTo EndSub
        Next: s = p & cmm.Caption & p: OldOp = 0: Op = 1
    Case "+", "*", "/", "Mod": s = p & cmm.Caption & p: Op = 1
    Case "Fix", "Sqr":  If b Then s = cmm.Caption & "(": OldOp = 0: Op = 1
    Case "(": If b Then s = cmm.Caption: OldOp = 0: Op = 1
    Case ")": If Not OldOp Then s = cmm.Caption Else GoTo EndSub
    Case "%": If Right$(cmb, 1) <> "%" Then s = cmm.Caption
    Case Else: s = cmm.Caption
    End Select
    If OldOp And Op Then GoTo EndSub
    OldOp = Op
    If Left$(cmb, 1) = "0" Then cmb = Mid$(cmb, 2)
    cmb.SelStart = pos
    cmb.SelText = s
    pos = pos + Len(s): Result = ""
    Exit Sub
EndSub: cmb.SelStart = pos
End Sub
 
Private Sub Form_Load()
    Dim o
    Const sL = 100, sz = 500, sT = sz + sL * 2
    Dim j$(), s$, i&, h&
    s = s & "7 8 9 = CE Sqr "
    s = s & "4 5 6 ( ) x^y "
    s = s & "1 2 3 + - Fix "
    s = s & "0 , % * / Mod "
    Set dic = CreateObject("scripting.dictionary"): dic.CompareMode = 1: j = Split(s)
    For Y = 0 To nY - 1: For X = 0 To nX - 1
            Set Matrix32(X, Y) = Controls.Add("vb.CommandButton", "cmm_" & X & Y)
            With Matrix32(X, Y)
                Select Case X
                Case 3, 4: .Move sL * 2 + X * sz, sT + Y * sz, sz, sz: .Visible = 1
                Case 5: .Move sL * 3 + X * sz, sT + Y * sz, sz * 1.5, sz: .Visible = 1
                Case Else: .Move sL + X * sz, sT + Y * sz, sz, sz
                End Select:  .FontSize = 10: .FontBold = 1: .Caption = j(i): i = i + 1: .Visible = 1
            End With
    Next: Next
    Set cmb = Controls.Add("vb.ComboBox", "cmb")
    With cmb
        .FontSize = 10: h = .Height
        .Move sL, Matrix32(0, 0).Top - h - sL, (Matrix32(nX - 1, 0).Left + Matrix32(nX - 1, 0).Width) - sL: .Visible = 1: .Text = 0
        Me.Width = .Width + sL * 3
    End With
    Set o = Controls("cmm_" & X - 1 & Y - 1)
    Me.Height = o.Top + o.Height + sz + sL
    Me.Caption = "Калькулятор VB ... © Антихакер32™"
    Set tmr = Controls.Add("vb.Timer", "tmr"): tmr.Interval = 10
End Sub
Private Sub tmr_Timer()
    Static OldName$
    If OldName <> ActiveControl.Name And ActiveControl.Name Like "cmm_##" Then
        Set cmm = ActiveControl
    End If: OldName = ActiveControl.Name
End Sub
Private Sub cmb_Validate(Cancel As Boolean): pos = cmb.SelStart: End Sub

@Pro_grammer · 12.07.2014, 18:49

Сообщение от Антихакер32

В этом коде я предусмотрел абсолютно все
переплюнул через себя и свою гордость и сделал
правилно работающую версию,

Не говори гоп, пока не перепрыгнешь!
Посчитай на бумажке 0.5% от 200 (или на калькуляторе от Микрософт), выходит =1.
Теперь на своем калькуляторе. Будет 0. И вообще, у тебя 0.99999% тоже =0.
теперь защита от дурака.
Пример 2+Sqr(-2) = 2, ответ не верный. Предупреждение о недопустимости такого аргумента у функции Sqr у тебя нет, а спокойно выдало результат!

P.S. Я не придираюсь, если что, а тестирую

@The trick · 12.07.2014, 18:55

Сообщение от Антихакер32

В этом коде я предусмотрел абсолютно все

Обсуждение работы проекта "Калькулятор со скобками и корнем"

Во-вторых, это мое мнение, код очень безобразно написан и новичкам его совсем не стоит показывать. Для чего таймер? Для чего подключение scrrun? Для чего все эти бездарные способы вычисления, какой-то гибрид рекурсивного спуска с говнокодом который крутит лишние циклы и выполняет ненужную работу непонятно зачем? Есть нормальные методы, тот же рекурсивный спуск, есть простой код преобразования в обратную польскую нотацию. Если взялся писать парсер математических выражений, то хотя бы почитал бы сначала об этом, о грамматиках. Я писал интерпретатор скриптового языка с нуля, там использовался метод преобразования в обратную нотацию и код даже меньше твоего. Но преимущество его в расширении, я мог туда добавить сколь угодно функций, в чем ценность твоего кода - не понятно.

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
Dim mError As ErrorDesc, errLex As clsLexem
 
Public Property Get ErrorLexem() As clsLexem
    Set ErrorLexem = errLex
End Property
 
Public Property Get LastError() As ErrorDesc
    LastError = mError
End Property
Public Property Let LastError(Value As ErrorDesc)
    mError = Value
End Property
 
Public Function Parse(Lexems As colLexem) As colLexem
    Dim N As Long, Op As New clsPushDown, Lex As clsLexem
    Dim Out As New colLexem, rOp As clsLexem, cOp As clsLexem
    Dim Unary As Boolean, Make As Boolean
    Unary = True
    N = 1
    Do
        Set Lex = Lexems(N)
            If Lex.Family = lexLftRndBr Then
                ' Если текущий элемент — открывающая скобка, то положим её в стек
                Op.Push Lex: Unary = True
            ElseIf Lex.Family = lexRghRndBr Then
                'До тех пор, пока верхним элементом стека не станет открывающая скобка,
                'выталкиваем элементы из стека в выходную строку. При этом открывающая
                'скобка удаляется из стека, но в выходную строку не добавляется. Если
                'после этого шага на вершине стека оказывается символ функции, выталкиваем
                'его в выходную строку. Если стек закончился раньше, чем мы встретили открывающую
                'скобку, это означает, что в выражении либо неверно поставлен разделитель, либо не согласованы скобки.
                If Op.Top Is Nothing Then Set errLex = Lex: mError = SyntaxError: Exit Function
                Do Until Op.Top.Family = lexLftRndBr
                    Set cOp = Op.Pop
                    ' Если операнда не существует значит ощибка
                    If (cOp Is Nothing) Then Set errLex = Lex: mError = SyntaxError: Exit Function
                    Out.AddObject cOp
                    ' Несогласованы скобки или разделитель
                    If Op.Top Is Nothing Then Set errLex = Lex: Set Out = Nothing: mError = SyntaxError: Exit Function
                Loop
                ' Извлекаем открывающуюся скобку
                Op.Pop
                Unary = False
            ElseIf IsOp(Lex) Then
                'Если символ является оператором о1, тогда:
                '1) пока…
                '… (если оператор o1 ассоциированный, либо лево-ассоциированный) приоритет o1 меньше либо равен
                'приоритету оператора, находящегося на вершине стека…
                '… (если оператор o1 право-ассоциированый) приоритет o1 меньше приоритета оператора, находящегося
                'на вершине стека…
                '… выталкиваем верхние элементы стека в выходную строку;
                '2) помещаем оператор o1 в стек.
                ' Если унарный минус или плюс
                If Unary And (Lex.Family = lexMinus Or Lex.Family = lexPlus) Then
                    Lex.Family = Lex.Family Or lexUnary
                End If
                Do While (Op.Count > 0)
                    ' Правоассоциатиывный оператор
                    If (Lex.Family = lexNegative Or Lex.Family = lexExp) And _
                       (Priority(Op.Top) > Priority(Lex)) Then
                        Make = True
                    ' Левоассоативный оператор
                    ElseIf Priority(Op.Top) >= Priority(Lex) Then
                        Make = True
                    Else
                        Exit Do
                    End If
                    If Make Then
                        Set cOp = Op.Pop
                        ' Если операции не существует значит ощибка
                        If cOp Is Nothing Then Set errLex = Lex: mError = SyntaxError: Exit Function
                        Out.AddObject cOp
                        Make = False
                    End If
                Loop
                Op.Push Lex
                Unary = True
            ElseIf Lex.Family = lexEndExpression Then
                ' Если конец выражения
                Do While Op.Count > 0
                    ' Не согласованы скобки
                    If Not IsOp(Op.Top) Then Set errLex = Op.Top: Set Out = Nothing: mError = SyntaxError: Exit Function
                    Out.AddObject Op.Pop
                Loop
            ElseIf IsVar(Lex) Or Lex.Family = lexFunctionID Or Lex.Family = lexInt Or Lex.Family = lexFloat Then
                ' Если символ является числом, переменной, фцнкцией добавить его к выходной строке
                Out.AddObject Lex
                Unary = False
            Else
                ' Ошибка
                If Lex.Family = lexID Then Set errLex = Lex: mError = VariableNotDefined: mPos = Lex.Pos: Exit Function
                mError = SyntaxError: Exit Function
            End If
            N = N + 1
    Loop While N <= Lexems.Count
    Out.Add lexEndExpression, ""
    Set Parse = Out
End Function
Private Function IsVar(Lex As clsLexem) As Boolean
If ((Lex.Family And lexLocalVar) = lexLocalVar) Or _
               ((Lex.Family And lexGlobalVar) = lexGlobalVar) Then IsVar = True
End Function
Private Function IsOp(Lex As clsLexem) As Boolean
    If Lex.Family = lexPlus Or _
       Lex.Family = lexMinus Or _
       Lex.Family = lexStar Or _
       Lex.Family = lexSlash Or _
       Lex.Family = lexExp Or _
       Lex.Family = lexEQ Or _
       Lex.Family = lexLE Or _
       Lex.Family = lexGE Or _
       Lex.Family = lexLT Or _
       Lex.Family = lexGT Or _
       Lex.Family = lexNE Or _
       Lex.Family = kwAnd Or _
       Lex.Family = kwOr Or _
       Lex.Family = kwNot Or _
       Lex.Family = kwXor Then IsOp = True
End Function
Private Function Priority(Lex As clsLexem) As Long
    If (Lex.Family And lexUnary) = lexUnary Then
        If (Lex.Family And lexMinus) = lexMinus Or (Lex.Family Or lexPlus) = lexPlus Then Priority = 6: Exit Function
    Else
        Select Case Lex.Family
        Case lexExp
            Priority = 5
        Case lexStar, lexSlash
 
            Priority = 4
        Case lexMinus, lexPlus
            Priority = 3
        Case lexEQ, lexLE, lexGE, lexLT, lexGT, lexNE
            Priority = 2
        Case kwOr, kwAnd, kwXor, kwNot
            Priority = 1
        End Select
    End If
End Function

@Антихакер32 · 12.07.2014, 18:56 **[ТС]**

Сообщение от Pro_grammer

Я не придираюсь, если что, а тестирую

да все в порядке, спасибо что указал,

я на The Tricka бывшего друга вчера злился,
за то что он меня неадекватом обозвал

@The trick · 12.07.2014, 19:02

Сообщение от Антихакер32

я на The Tricka бывшего друга вчера злился,
за то что он меня неадекватом обозвал

Я тебя не обзывал. Покажи сообщение где я написал что ты неадекват

. Я написал что-ты неадекватно реагируешь на критику - это правда, если это не так пусть меня кто-то поправит и укажет что я не прав где-то. Я лично на каждое высказывание привел примеры твоих действий. И кстати, еще раз ересь в мою сторону напишешь я тебе еще нарушение выдам. И теперь я твои примеры буду лично тестировать до идеала.

@Антихакер32 · 12.07.2014, 22:38 **[ТС]**

Сообщение от The trick

в чем ценность твоего кода - не понятно

У меня хотябы это все работает и запускается
более того я
адаптировал под VBA

а то что ты выложил, не запускается, и я даже разбираться не хочу
что это

@The trick · 12.07.2014, 22:58

Сообщение от Антихакер32

а то что ты выложил, не запускается, и я даже разбираться не хочу
что это

То что я выложил это пример математического парсера из моего скриптового движка, который я выложил для примера, и который работает и с функциями и легко расширяется. Естественно я его выложил в качестве демонстрации алгоритма и размера кода, а не в виде готового решения. Это я думаю было понятно если ты хотя бы немного разбираешься в VB6 по таким декларациям как colLexem, clsLexem и им подобным. Понимаешь, человек который пишет такие вещи как парсер мат-выражений должен хоть поверхностно знать теорию, и знать как работать со стековой машиной для реализации преобразования выражения в обратную нотацию. Ему мой код был бы очень полезен и он бы не тупо копировал его, а анализировал и брал алгоритмическую часть, которая, при знании теории (даже поверхностно) очень отчетливо видна, к тому же стоят подробные комментарии, в отличии от твоего кода. Но, как я уже заметил, тебе нужно все готовенькое. Вот я выложил код сюда, дабы ты исправил свой "код" чтобы он был соответствующего вида и дал тебе подсказку, но ты написал

Сообщение от Антихакер32

я даже разбираться не хочу

.
Твой "код" как был с недостатками так и остался, я бы на месте модераторов раздела VBA также бы его отправил на доработку.

@Антихакер32 · 12.07.2014, 23:01 **[ТС]**

Там есть момент с таймером, так вот для меня стало новостью что в VBA
таймера нет, но и тут я нашел способ

Visual Basic
1
2
3
4
5
6
7
8
9
10
11
Private Sub UserForm_Activate()
    'Эмуляция таймера
    Do: DoEvents: Sleep 10: tmr_Timer: Loop
End Sub
Private Sub tmr_Timer()
    Static OldName$
    On Error Resume Next
    If OldName <> ActiveControl.Name And ActiveControl.Name Like "cmm_##" Then
        Set cmm = ActiveControl
    End If: OldName = ActiveControl.Name
End Sub

Dragokas · 12.07.2014, 23:03

Антихакер32, упаси бог. Разбираться в чужом коде без комментариев.
Я лучше свой парсер напишу. Хотя бы буду знать точно как он работает.

Добавлено через 44 секунды
Расскажи хотя бы зачем парсеру таймер?

@The trick · 12.07.2014, 23:04

Сообщение от Антихакер32

Visual Basic
1
Do: DoEvents: Sleep 10: tmr_Timer: Loop

Такому коду вообще не место, по крайней мере в этом разделе.

@Антихакер32 · 12.07.2014, 23:08 **[ТС]**

Сообщение от Dragokas

Расскажи хотя бы зачем парсеру таймер?

Расскажу:
Таймер нужен для опроса кнопок, тоесть какая кнопка активна
та будет обрабатываться всеми событиями

Добавлено через 1 минуту

Сообщение от Dragokas

упаси бог. Разбираться в чужом коде без комментариев.

Нужно будет довести до совершенства, когда никто не сможет прикопаться
после чего я каждую строчку прокоментирую, мне не жалко

@The trick · 12.07.2014, 23:20

Сообщение от Антихакер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
Option Explicit
 
Dim WithEvents btn As CommandButton
 
Private Sub btn_Click()
    MsgBox btn.Name
End Sub
 
Private Sub btn_LostFocus()
    Set btn = ActiveControl
End Sub
 
Private Sub Form_Activate()
    Set btn = ActiveControl
End Sub
 
Private Sub Form_Load()
    Dim Z As Long
    
    For Z = 0 To 9
        Set btn = Me.Controls.Add("VB.CommandButton", "btn_" & CStr(Z))
        btn.Visible = True
        btn.Move 10, 500 * Z
    Next
    
End Sub

Вот так нужно обрабатывать события кнопки, добавленной динамически. Это исходит из того, что кнопка имеет событие LostFocus к которому можно привязать очередной контрол (в данном случае это только кнопка).
А вот говнокод со Sleep (я думаю многие так думают), который будет вешать поток периодически - это верх невежества.

Новые блоги и статьи Все статьи Все блоги /
Генератор паролей (вариант №1) Maks 29.10.2026 Реализация из решения ниже выполнена исключительно по моей инициативе, дабы облегчить себе работу в создании паролей для администрируемых мною сервисов и пользователей. Самым главным критерием для. . .	Установка ChatGPT (Codex) на Windows без использования Microsoft Store Fabien159 28.10.2026 Здравствуйте всем читающим! Опишу процесс установки ChatGPT (Codex) на Windows, если по каким-то причинам у вас не получается устанавить его через Microsoft Store. И так: 1. Скачиваем с. . .	Программное добавление префикса в нумерацию документов Maks 27.10.2026 Реализация из решения ниже выполнена в самописной конфигурации на БСП (помощь начинающему коллеге). Задача: Программно добавить префикс в нумерацию документов. Решение: В модуле объекта. . .	После закрытия оутлука продолжает висеть процесс в диспетчере задач Maks 27.10.2026 С недавнего времени в продакшене возникла проблема: при закрытии оутлука в диспетчере задач продолжал висеть процесс outlook. exe. Проблема возникла после установки MS Office 2021 LTSC на машинах, под. . .
Baragoz - DPS/HPS бот для WoW 3.3.5a, многоязычный AmbA 26.10.2026 Хотите ещё ботов? У меня есть один! А я пока отдохну от него. https:/ / www. cyberforum. ru/ blog_attachment. php?attachmentid=12062&stc=1&d=1793007952 Инструкция внутри. https:/ / youtu. be/ VpfFZSUDGnQ. . .	Особенности gif сгенерированных в Си russiannick 21.10.2026 Рассмотрим генерацию gif файлов, которые в Си имеют свои особенности. Gif представляет собой графический формат популярный в интернете. Посмотрим на палитру. Gif файл сгенерированный в си отличается. . .	FPS контроллер с анимированными Y-Bot и 3D-звуком miniaudio (Box3D, Recast, BehaviorTree.CPP, ozz-animation, ImGui, OpenGL и SDL3) 8Observer8 18.10.2026 Содержание блога \| English Version Полное мультиплатформенное руководство по стартовому проекту с FPS-контроллером игрока, анимированными роботами Y-Bot с 4-слойным блендингом, 3D-физикой Box3D,. . .	Локальный http сервер Argus19 17.10.2026 Локальный http сервер На работе, на двух локальных компьютерах круглосуточно работают программы опроса приборов с записью в книги Excel,которые раз в сутки записываются на сервер компании. Т. к. . . .

@Антихакер32 1201 / 473 / 46 Регистрация: 06.01.2014 Сообщений: 1,797 Записей в блоге: 19
	11.07.2014, 22:02 [ТС]
	Pro_grammer помог, указал на ошибки и я их исправил и это я не вижу никакой связи с вашими постами 0

Dragokas 18035 / 7738 / 892 Регистрация: 25.12.2011 Сообщений: 11,502 Записей в блоге: 16
	12.07.2014, 02:17
	Антихакер32, пиши ИСЧО 0

Dragokas 18035 / 7738 / 892 Регистрация: 25.12.2011 Сообщений: 11,502 Записей в блоге: 16
	12.07.2014, 23:03
	Антихакер32, упаси бог. Разбираться в чужом коде без комментариев. Я лучше свой парсер напишу. Хотя бы буду знать точно как он работает. Добавлено через 44 секунды Расскажи хотя бы зачем парсеру таймер? 0