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

@Антихакер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

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

Спасибо.., вообщето я бы и сам догадался
уже была такая мысль что при потере фокуса,
переводить ссылку на того кто стал активным

@The trick · 12.07.2014, 23:34

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

Спасибо.., вообщето я бы и сам догадался

Не уверен, ты вместо таймера прилепил !!цикл!!, так бы и оставил, раз ты уже проигнорировав этот и этот пост выложил.

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

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

Где была?

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

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

ты вместо таймера прилепил !!цикл!!

А что еще делать в VBA нет события для кнопки LostFocus

Dragokas · 12.07.2014, 23:58

Антихакер32, запили несколько тем с демонстрациями от простого к сложному
по работе с динамическими контролами.
Вот когда каждая тема будет вылизана до идеала - это будут самые лучшие готовые примеры.

А пока то, что ты объяснил - я вообще ничего не понял.
А то, что объяснил The trick, понял только слегка, потому что нет необходимости разбираться.
Если бы ты взял этот кусочек кода и написал от и до - что почему и зачем - вот это было бы самым лучшим примером.

А пока повторю - что мне хватает встроенного калькулятора Виндовс, благо умеет работать с разными СС.
P.S. И здесь не раздел VBA.

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

Ну понятно что можно стандартный калькулятор вызвать и все..
зато на основе новых знаний, полученных пусть и не самым приятным
способом, я могу собирать различные объекты и в VB6 и в VBA
причем в VBA, многие вещи могут уже сейчас быть очень востребованными
а как вы хотели.. без практики, ничего бы не узнавалось небыло бы этих постов
в споре рождается истина, как говорили наши дедушки

Dragokas · 13.07.2014, 00:41

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

@The trick · 13.07.2014, 00:42

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

А что еще делать в VBA нет события для кнопки LostFocus

Ты у меня спрашиваешь?

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

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

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

Вся эта затея - просто спортивный интерес, написать такое, что редко кто делает вообще, а на VB6 тем более (тоже относится практически ко всем моим проектам). Если бы я хотел написать инсталлятор, я бы это сделал на C++ или ассемблере без всяких этих заморочек, намного быстрей и прикладывая значительно меньше усилий.

Лично мне это не нужно, я знаю VB6 в совершенстве настолько близко, что ты даже себе не представляешь. Я знаю практически обо всем что происходит "за кулисами", практически все внутренности рантайма. Я постоянно изучаю WinAPI (каждый день), COM и многое другое. И потом применяю эти знания на практике для себя (написание программ, разработка устройств) и для других (те же готовые решения, либо любая другая помощь на форуме и в реале).
А вот чему учит твой данный "код"? Другие коды? Что нового, допустим рядовой пользователь , сможет из него почерпнуть? Я, как разбирающийся в этом, вижу только кучу ошибок (в том числе и грамматических). Конечно ошибки есть у всех, но люди их исправляют, совершенствуются. В моих кодах также есть ошибки, где-то по невнимательности, где-то что-то упустил, но если я (мне) их найду(т) я их исправлю. Во-вторых код должен делать только то, что от него хотят, и ничего более, иначе нужно описывать все "побочные действия". Нужно писать код так, как будто процессорное время стоит денег и немалых, нужно экономить его - это правила хорошего тона. Также код должен быть оформлен нормально, прокомментирован. Тогда этот код будет хорошим кандидатом на публикацию.
Я тебе назвал кучу недостатков, и могу еще кучу назвать.

@Антихакер32 · 13.07.2014, 10:30 **[ТС]**

Исправил

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

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
Option Explicit
'
'Калькулятор на VB ... © Антихакер32™ ...2014
'
Const nX = 6, nY = 4, p = " ", _
Promt1 = "<Деление на 0>", Promt2 = "<Переполнение>", _
Promt3 = "<Недопустимый аргумент>"
Dim Matrix32(nX - 1, nY - 1) As CommandButton
Dim WithEvents cmm As CommandButton
Dim WithEvents cmb As ComboBox
Dim pos&, dic As Object, X&, Y&
Private Function RG(Expression$) 'Reduction Gaps
    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))
    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)
            s = Mid(j(f), Le + 1) '<-- Числовой аргумент функций
            If Right$(j(f), 1) = "%" Then j(f) = CDbl(Left$(j(f), Len(j(f)) - 1)) / 100
            Select Case Left$(j(f), Le)
            Case "SQR":  If s < 0 Then Calc = Promt3: Exit Function
                j(f) = Sqr(s)
            Case "FIX": j(f) = Fix(s)
            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$: Static Result$, f&, b(2) As Boolean
    cmb.SetFocus: b(0) = 0 'Сброс оператора
    If Len(Result) Then
        If IsNumeric(cmm.Caption) Then cmb.Text = ""
        Select Case cmm.Caption
        Case "Sqr", "Fix": cmb.Text = ""
        End Select
    End If: b(2) = b(1) Or cmb.Text = "0" Or cmb.Text = ""
    Select Case cmm.Caption
    Case "="
        f = InStr(1, cmb, "="): If f Then cmb.Text = Left$(cmb, f - 1)
        Result = Calc(cmb): cmb.Text = Trim$(Replace(cmb, p & p, p))
        s = cmb & " = " & Result: cmb.Text = Result
        If Not dic.Exists(s) Then dic.Add s, 0: cmb.AddItem s
        cmb.Text = Result: pos = Len(cmb): cmb.SelStart = pos: Erase b: GoTo EndSub
    Case "CE": cmb.Text = 0: pos = 1: cmb.SelStart = pos: Erase b: GoTo EndSub
    Case "x^y": s = p & "^" & p: b(0) = 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: b(1) = 0: b(0) = 1
    Case "+", "*", "/", "Mod": s = p & cmm.Caption & p: b(0) = 1
    Case "," 'Проверка на повтор разделителя
        For f = Len(cmb) To 1 Step -1: s = Mid$(cmb, f, 1)
            If s = "," Then
                GoTo EndSub
            ElseIf Not IsNumeric(s) Then Exit For
            End If
        Next: s = cmm.Caption
    Case "Fix", "Sqr":  If b(2) Then s = cmm.Caption & "(": b(1) = 0: b(0) = 1
    Case "(": If b(2) Then s = cmm.Caption: b(1) = 0: b(0) = 1
    Case ")": If Not b(1) Then s = cmm.Caption Else GoTo EndSub
    Case "%": If Right$(cmb, 1) <> "%" Then s = cmm.Caption
    Case Else: s = cmm.Caption
    End Select
    If b(1) And b(0) Then GoTo EndSub Else b(1) = b(0)
    If Left$(cmb, 1) = "0" Then cmb.Text = 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™"
End Sub
Private Sub cmm_LostFocus()
    If ActiveControl.Name Like "cmm_##" Then Set cmm = ActiveControl
End Sub
Private Sub Form_Activate()
    cmb.SetFocus: cmb.SelStart = Len(cmb)
End Sub
Private Sub cmb_LostFocus(): cmm_LostFocus: End Sub
Private Sub cmb_Validate(Cancel As Boolean): pos = cmb.SelStart: End Sub

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

Добавлено через 1 час 15 минут
И это все только калькулятор!
представляю что бы было, если бы я захотел на форуме раздела VB6 выложить
открытый код для создания блок-схем, там тоже динамически создаваемые
объекты, и их очень много, код еще не доработан, но уже многое там работает

сейчас нет никакого желания выкладывать его здесь, чтоб не раздражать великих людей

@The trick · 13.07.2014, 11:38

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

жаль что этот код затеряется, из за чьих-то амбиций

Это к лучшему, т.к. код содержит ошибки.Для чего Dictionary? Он не нужен в данной реализации вообще, и как ты его используешь (я понял для чего) - это ничего не даст. Вот пример -
Название: Bad3.png
Просмотров: 79

Размер: 10.0 Кб

Название: Bad3.png
Просмотров: 79

Размер: 10.0 Кб

И по традиции список ошибок, найденных за первые 10 минут теста:
Никаких предупреждений о неправильном вводе -
Название: Bad2.png
Просмотров: 79

Размер: 8.6 Кб

Название: Bad2.png
Просмотров: 79

Размер: 8.6 Кб

Название: Bad1.png
Просмотров: 79

Размер: 11.6 Кб

Форма неправильно задает начальные размеры, это так к сведению -
Название: Bad4.png
Просмотров: 80

Размер: 14.7 Кб

Неправильно считает выражение -
Название: Bad5.png
Просмотров: 81

Размер: 11.5 Кб

Никаких предупреждений о делении на 0 -
Название: Bad6.png
Просмотров: 80

Размер: 11.3 Кб

Где тут ноль?
Название: Bad7.png
Просмотров: 85

Размер: 8.6 Кб

Неверный результат
Название: Bad8.png
Просмотров: 83

Размер: 8.9 Кб

@Антихакер32 · 13.07.2014, 11:57 **[ТС]**

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

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

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

Форма неправильно задает начальные размеры, это так к сведению -

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

@The trick · 13.07.2014, 12:07

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

Дело в том, что я пока не предусмотрел ввод с клавиатуры

И что из этого? Значит можно с ошибками оставлять? Нет уж переделывай.

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

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

А зачем тогда ты по таймеру делал определение активного контрола? В таком случае это бы не работало. Это же каким нужно быть извращенцем чтобы так делать (загружать EXE для просчета выражения нажатием кнопок)?
Любой пользователь лучше напишет так как посоветовал Dragokas, через Eval, намного быстрее и многократно функциональнее.

Visual Basic
1
2
3
4
5
6
7
8
9
10
11
Option Explicit
 
Private Sub Form_Load()
    Dim Script  As Object
    Dim ret     As Variant
    
    Set Script = CreateObject("MSScriptControl.ScriptControl")
    Script.Language = "VBScript"
    
    ret = Script.Eval("125+Sqr(25) * Fix(5*2.1) + cos(0)")
End Sub

@Антихакер32 · 13.07.2014, 12:34 **[ТС]**

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

MSScriptControl.ScriptControl

да это все не то !, у меня ручками написанно, к тому-же в моей
Windows нет этого объекта, и вообще неиспользуется ничего кроме
Dictionary, и его я позже заменю на коллекцию

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

Добавлено через 13 минут
Ну и это еще не все, у меня есть dll реализующая подсчет
с любой разрядностью числа, тоесть код этой dll я тоже добавлю
и можно будет увеличить точность подсчета без всяких E+16 ...E-16

@The trick · 13.07.2014, 12:39

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

да это все не то !, у меня ручками написанно

Да ты только что писал что это делается для того чтобы рассчитывать значение из родительской проги. Я тебе написал что все пользователи лучше сделают через Eval. При чем здесь "ручками"? Этот пример был дан в качестве того, что твой код никто не будет использовать по назначению которое указал ты. Тем более ручками у тебя вышло намного глючней и ничего полезного там нет.

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

к тому-же в моей Windows нет этого объекта

Это твои проблемы, начиная с Windows 2000 библиотека идет вместе с системой.

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

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

Опять говнокод

... Я дам тебе подсказку - не легче запретить ввод в комбобокс?

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

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

Ну и это еще не все, у меня есть dll реализующая подсчет
с любой разрядностью числа, тоесть код этой dll я тоже добавлю
и можно будет увеличить точность подсчета без всяких E+16 ...E-16

Дай угадаю, эта (arithm.zip)?

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

Вот сделал по твоему, скачал эту DLL и установил
правда теперь процент не работает, а так вроде норм

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
Option Explicit
'
'Калькулятор на VB ... © Антихакер32™ ...2014
'
Const nX = 6, nY = 4, p = " ", _
Promt1 = "<Деление на 0>", Promt2 = "<Переполнение>", _
Promt3 = "<Недопустимый аргумент>"
Dim Matrix32(nX - 1, nY - 1) As CommandButton
Dim WithEvents cmm As CommandButton
Dim WithEvents cmb As ComboBox
Dim pos&, dic As Object, X&, Y&, Script As Object
'-----------------------------------------[Типы]
Private Type InitCommonControlsExStruct
    lngSize As Long
    lngICC As Long
End Type
 
Private Declare Function InitCommonControlsEx Lib "comctl32.dll" (iccex As InitCommonControlsExStruct) As Boolean
Private Declare Function LoadLibrary Lib "kernel32.dll" Alias "LoadLibraryA" (ByVal lpLibFileName As String) As Long
Private Declare Function FreeLibrary Lib "kernel32.dll" (ByVal hLibModule As Long) As Long
 
Private Function Calc(ByVal Expression$)
    Calc = Script.Eval(RG(Expression))
End Function
 
Private Sub Form_Initialize()
    Dim iccex As InitCommonControlsExStruct, hMod As Long
    Set Script = CreateObject("MSScriptControl.ScriptControl")
    Script.Language = "VBScript"
    With iccex
        .lngSize = LenB(iccex)
        .lngICC = &H4000& ' vb intrinsic controls (buttons, textbox, etc)
    End With
    On Error Resume Next ' error? Requires IEv3 or above
    hMod = LoadLibrary("shell32.dll")
    InitCommonControlsEx iccex
    If hMod Then FreeLibrary hMod
End Sub
 
Private Function RG(Expression$) 'Reduction Gaps
    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))
    Next: RG = Trim$(Join(j))
    RG = Replace(RG, "E + ", "E+"): RG = Replace(RG, "E -", "E-"): RG = Replace(RG, p & p, p)
End Function
 
Private Sub cmm_Click()
    Dim s$: Static Result$, f&, b(2) As Boolean
    cmb.SetFocus: b(0) = 0 'Сброс оператора
    If Len(Result) Then
        If IsNumeric(cmm.Caption) Then cmb.Text = ""
        Select Case cmm.Caption
        Case "Sqr", "Fix": cmb.Text = ""
        End Select
    End If: b(2) = b(1) Or cmb.Text = "0" Or cmb.Text = ""
    Select Case cmm.Caption
    Case "="
        f = InStr(1, cmb, "="): If f Then cmb.Text = Left$(cmb, f - 1)
        Result = Calc(cmb): cmb.Text = Trim$(Replace(cmb, p & p, p))
        s = cmb & " = " & Result: cmb.Text = Result
        If Not dic.Exists(s) Then dic.Add s, 0: cmb.AddItem s
        cmb.Text = Result: pos = Len(cmb): cmb.SelStart = pos: Erase b: GoTo EndSub
    Case "CE": cmb.Text = 0: pos = 1: cmb.SelStart = pos: Erase b: GoTo EndSub
    Case "x^y": s = p & "^" & p: b(0) = 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: b(1) = 0: b(0) = 1
    Case "+", "*", "/", "Mod": s = p & cmm.Caption & p: b(0) = 1
    Case "," 'Проверка на повтор разделителя
        For f = Len(cmb) To 1 Step -1: s = Mid$(cmb, f, 1)
            If s = "," Then
                GoTo EndSub
            ElseIf Not IsNumeric(s) Then Exit For
            End If
        Next: s = cmm.Caption
    Case "Fix", "Sqr":  If b(2) Then s = cmm.Caption & "(": b(1) = 0: b(0) = 1
    Case "(": If b(2) Then s = cmm.Caption: b(1) = 0: b(0) = 1
    Case ")": If Not b(1) Then s = cmm.Caption Else GoTo EndSub
    Case "%": If Right$(cmb, 1) <> "%" Then s = cmm.Caption
    Case Else: s = cmm.Caption
    End Select
    If b(1) And b(0) Then GoTo EndSub Else b(1) = b(0)
    If Left$(cmb, 1) = "0" Then cmb.Text = 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™"
End Sub
Private Sub cmm_LostFocus()
    If ActiveControl.Name Like "cmm_##" Then Set cmm = ActiveControl
End Sub
Private Sub Form_Activate()
    cmb.SetFocus: cmb.SelStart = Len(cmb)
End Sub
Private Sub cmb_LostFocus(): cmm_LostFocus: End Sub
Private Sub cmb_Validate(Cancel As Boolean): pos = cmb.SelStart: End Sub

Добавлено через 14 минут
вобщем подстраиваться нужно будет под MSScriptControl.ScriptControl

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

Дай угадаю, эта (arithm.zip)?

нет

@The trick · 13.07.2014, 13:07

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

Вот сделал по твоему, скачал эту DLL и установил

Что по-моему? Ты читал пост? Вот вникай в смысл пока не дойдет. Зачем тогда весь этот код, когда можно обойтись одной строкой

Visual Basic
1
Script.Eval(Expression)

и в чем ценность этого кода?
Для чего вся байда с InitCommonControlsEx? Стили работают и без этого Project1.rar.

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

Нет

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

@Антихакер32 · 13.07.2014, 13:29 **[ТС]**

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

Project1.rar

какая байда ? И что это за странный проект, exe-шник который не запускается

@Антихакер32 · 13.07.2014, 14:29 **[ТС]**

Сделал все правильно

все, можеш отправить в готовые решения, и затереть тут лишнее

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
Option Explicit
'
'Калькулятор на VB ... © Антихакер32™ ...2014
'
#Const Manifest = 0 'Если будет 0 или отсутствовать эта константа, то стилей не будет
 
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 pos&, col As Collection, X&, Y&, Script As Object
#If Manifest Then 'Часть кода для реализация стиля Windows
    Private Type InitCommonControlsExStruct
        lngSize As Long
        lngICC As Long
    End Type
    Private Declare Function InitCommonControlsEx Lib "comctl32.dll" (iccex As InitCommonControlsExStruct) As Boolean
    Private Declare Function LoadLibrary Lib "kernel32.dll" Alias "LoadLibraryA" (ByVal lpLibFileName As String) As Long
    Private Declare Function FreeLibrary Lib "kernel32.dll" (ByVal hLibModule As Long) As Long
#End If
 
Private Function Calc(ByVal Expression$)
    Dim s$, j$(), f&
    On Error GoTo EndFunction
    f = InStr(1, Expression, "<")
    If f Then Calc = Mid$(Expression, f): Calc = Left$(Calc, InStr(1, Calc, ">")): Exit Function
    Expression = Trim$(Split(Expression, "=")(0))
    s = p & p: While InStr(1, Expression, s): Expression = Replace(Expression, s, p): Wend
    j = Split(Expression)
    For f = 0 To UBound(j): s = j(f)
        If Right$(s, 1) = "%" Then j(f) = CDbl(Left$(s, Len(s) - 1)) / 100
    Next: Expression = Join(j)
    Expression = Replace(Expression, ",", ".")
    Calc = Script.Eval(Expression)
    Exit Function
EndFunction:
    Calc = "<" & Err.Description & ">"
End Function
Private Sub cmm_Click()
    Dim s$: Static Result$, f&, b(2) As Boolean
    cmb.SetFocus: b(0) = 0 'Сброс оператора
    If Len(Result) Then
        If IsNumeric(cmm.Caption) Then cmb.Text = ""
        Select Case cmm.Caption
        Case "Sqr", "Fix": cmb.Text = ""
        End Select
    End If: b(2) = b(1) Or cmb.Text = "0" Or cmb.Text = ""
    Select Case cmm.Caption
    Case "="
        f = InStr(1, cmb, "="): If f Then cmb.Text = Left$(cmb, f - 1)
        Result = Calc(cmb): cmb.Text = Trim$(Replace(cmb, p & p, p))
        s = cmb & " = " & Result: cmb.Text = Result
        On Error Resume Next: col.Add 0, s
        If Err.Number = 0 Then cmb.AddItem s Else Err.Clear
        cmb.Text = Result: pos = Len(cmb): cmb.SelStart = pos: Erase b: GoTo EndSub
    Case "CE": cmb.Text = 0: pos = 1: cmb.SelStart = pos: Erase b: GoTo EndSub
    Case "x^y": s = p & "^" & p: b(0) = 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: b(1) = 0: b(0) = 1
    Case "+", "*", "/", "Mod": s = p & cmm.Caption & p: b(0) = 1
    Case "," 'Проверка на повтор разделителя
        For f = Len(cmb) To 1 Step -1: s = Mid$(cmb, f, 1)
            If s = "," Then
                GoTo EndSub
            ElseIf Not IsNumeric(s) Then Exit For
            End If
        Next: s = cmm.Caption
    Case "Fix", "Sqr":  If b(2) Then s = cmm.Caption & "(": b(1) = 0: b(0) = 1
    Case "(": If b(2) Then s = cmm.Caption: b(1) = 0: b(0) = 1
    Case ")": If Not b(1) Then s = cmm.Caption Else GoTo EndSub
    Case "%": If Right$(cmb, 1) <> "%" Then s = cmm.Caption
    Case Else: s = cmm.Caption
    End Select
    If b(1) And b(0) Then GoTo EndSub Else b(1) = b(0)
    If Left$(cmb, 1) = "0" Then cmb.Text = 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 Script = CreateObject("MSScriptControl.ScriptControl"): Script.Language = "VBScript"
    Set col = New Collection: 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 * 2 + (Me.Width - ScaleWidth)
    End With
    Set o = Controls("cmm_" & X - 1 & Y - 1)
    Me.Height = o.Top + o.Height + sz + sL
    Me.Caption = "Калькулятор VB ... © Антихакер32™"
End Sub
Private Sub Form_Initialize()
    #If Manifest Then 'Часть кода для реализация стиля Windows
        Dim iccex As InitCommonControlsExStruct, hMod As Long
        With iccex: .lngSize = LenB(iccex): .lngICC = &H4000&: End With
        On Error Resume Next
        hMod = LoadLibrary("shell32.dll"): InitCommonControlsEx iccex
        If hMod Then FreeLibrary hMod
    #End If
End Sub
Private Sub cmm_LostFocus()
    If ActiveControl.Name Like "cmm_##" Then Set cmm = ActiveControl
End Sub
Private Sub Form_Activate()
    cmb.SetFocus: cmb.SelStart = Len(cmb)
End Sub
Private Sub cmb_LostFocus(): cmm_LostFocus: End Sub
Private Sub cmb_Validate(Cancel As Boolean): pos = cmb.SelStart: End Sub

@The trick · 13.07.2014, 15:03

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

Сделал все правильно

Нет.
Во-первых, изучи comctl32.dll API, и не нужно придумывать фигню в Form_Initialize.
Во-вторых, вместо процента можно написать "*0.01" и отправлять в Eval, без лишнего кода.
В-третьих, после этих правок, какой "коэффициент полезного решения" будет в этом коде.
В-четвертых, где подробные комментарии?
Что пользователь может узнать нового из этого? Практически это аналог того что посоветовал Dragokas. Если хочешь опубликовать пример работы со Script контролом, то оформи соответствующе тему и оставь только Script контрол и описание его работы.
Я это пишу потому что очень много говнокода стало в готовых решениях, и я как модератор, буду отсеивать такой код. Если честно - надоело. Если хоть один из опытных пользователей посчитает этот код достойным, я его опубликую, модераторы также могут его опубликовать там без моего согласия. Я - против.
Если бы ты действительно правильно написал парсер математических выражений без сторонних либ (типа msscript), то я бы с большим удовольствием опубликовал его и поднял тебе репу за полезное решение. А так, в данном виде я считаю это плохим решением, которое ни в коем случае не следуют показывать новичкам.

@Антихакер32 · 13.07.2014, 15:29 **[ТС]**

Вот еще лучше..
я даже не поленился прокоментировать некоторые моменты
и я фигню не придумываю, у меня все работает как в аптеке
кроме того, я и так подробно все объяснил в коде, и понятно
как там можно добавить свои кнопки и функции, если есть такая необходимость
больше я калькулятором заниматься не буду

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
Option Explicit
'
'Калькулятор на VB ... © Антихакер32™ ...2014
'
#Const Manifest = 1 'Если будет 0 или отсутствовать эта константа, то стилей не будет
 
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 pos&, col As Collection, X&, Y&, Script As Object
#If Manifest Then 'Часть кода для реализация стиля Windows
    Private Type InitCommonControlsExStruct
        lngSize As Long
        lngICC As Long
    End Type
    Private Declare Function InitCommonControlsEx Lib "comctl32.dll" (iccex As InitCommonControlsExStruct) As Boolean
    Private Declare Function LoadLibrary Lib "kernel32.dll" Alias "LoadLibraryA" (ByVal lpLibFileName As String) As Long
    Private Declare Function FreeLibrary Lib "kernel32.dll" (ByVal hLibModule As Long) As Long
#End If
 
Private Function Calc(ByVal Expression$)
    Dim s$, j$(), f&
    On Error GoTo EndFunction
    f = InStr(1, Expression, "<") 'Если в выражениях есть тег ошибки то выход
    If f Then Calc = Mid$(Expression, f): Calc = Left$(Calc, InStr(1, Calc, ">")): Exit Function
    Expression = Trim$(Split(Expression, "=")(0)) 'Отсееваем до знака равенства
    Expression = Replace(Expression, "%", "*0.01") 'Переименовать процент
    s = p & p: While InStr(1, Expression, s): Expression = Replace(Expression, s, p): Wend
    Expression = Replace(Expression, ",", ".") 'Переименовать разделитель для Eval
    Calc = Script.Eval(Expression) 'Вычисление !
    Exit Function
EndFunction:
    Calc = "<" & Err.Description & ">"
End Function
Private Sub cmm_Click()
    Dim s$: Static Result$, f&, b(2) As Boolean
    cmb.SetFocus: b(0) = 0 'Сброс оператора
    If Len(Result) Then 'Сброс если после прежнего результата, пойдет ввод цифр
        If IsNumeric(cmm.Caption) Then cmb.Text = ""
        Select Case cmm.Caption
        Case "Sqr", "Fix": cmb.Text = ""
        End Select
    End If: b(2) = b(1) Or cmb.Text = "0" Or cmb.Text = ""
    Select Case cmm.Caption 'Действия по вводу зависимо от активного названия кнопки
    Case "="
        f = InStr(1, cmb, "="): If f Then cmb.Text = Left$(cmb, f - 1)
        Result = Calc(cmb): cmb.Text = Trim$(Replace(cmb, p & p, p))
        s = cmb & " = " & Result: cmb.Text = Result
        On Error Resume Next: col.Add 0, s 'Попытаться добавить в коллекцию
        If Err.Number = 0 Then cmb.AddItem s Else Err.Clear
        cmb.Text = Result: pos = Len(cmb): cmb.SelStart = pos: Erase b: GoTo EndSub
    Case "CE": cmb.Text = 0: pos = 1: cmb.SelStart = pos: Erase b: GoTo EndSub
    Case "x^y": s = p & "^" & p: b(0) = 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: b(1) = 0: b(0) = 1
    Case "+", "*", "/", "Mod": s = p & cmm.Caption & p: b(0) = 1
    Case "," 'Проверка на повтор разделителя
        For f = Len(cmb) To 1 Step -1: s = Mid$(cmb, f, 1)
            If s = "," Then
                GoTo EndSub
            ElseIf Not IsNumeric(s) Then Exit For
            End If
        Next: s = cmm.Caption
    Case "Fix", "Sqr":  If b(2) Then s = cmm.Caption & "(": b(1) = 0: b(0) = 1
    Case "(": If b(2) Then s = cmm.Caption: b(1) = 0: b(0) = 1
    Case ")": If Not b(1) Then s = cmm.Caption Else GoTo EndSub
    Case "%": If Right$(cmb, 1) <> "%" Then s = cmm.Caption
    Case Else: s = cmm.Caption
    End Select
    If b(1) And b(0) Then GoTo EndSub Else b(1) = b(0)
    If Left$(cmb, 1) = "0" Then cmb.Text = 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()
    Const sL = 100, sz = 500, sT = sz + sL * 2
    Dim j$(), s$, i&, h&, o As Object 'Динамическое создание объектов !
    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 Script = CreateObject("MSScriptControl.ScriptControl"): Script.Language = "VBScript"
    Set col = New Collection: 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 * 2 + (Me.Width - ScaleWidth)
    End With
    Set o = Controls("cmm_" & X - 1 & Y - 1)
    Me.Height = o.Top + o.Height + sz + sL
    Me.Caption = "Калькулятор VB ... © Антихакер32™"
End Sub
Private Sub Form_Initialize()
    #If Manifest Then 'Часть кода для реализация стиля Windows
        Dim iccex As InitCommonControlsExStruct, hMod As Long
        With iccex: .lngSize = LenB(iccex): .lngICC = &H4000&: End With
        On Error Resume Next
        hMod = LoadLibrary("shell32.dll"): InitCommonControlsEx iccex
        If hMod Then FreeLibrary hMod
    #End If
End Sub
Private Sub cmm_LostFocus() 'Передача фокуса из матрицы кнопок
    If ActiveControl.Name Like "cmm_##" Then Set cmm = ActiveControl
End Sub
Private Sub Form_Activate()
    cmb.SetFocus: cmb.SelStart = Len(cmb)
End Sub
Private Sub cmb_LostFocus(): cmm_LostFocus: End Sub
Private Sub cmb_Validate(Cancel As Boolean): pos = cmb.SelStart: End Sub

Новые блоги и статьи Все статьи Все блоги /
Про "Windows must die!" kumehtar 04.11.2026 Знаете, чет накатило. . . . Когда-то это было почти боевым кличем: мол, нормальный человек сидит на DOS, OS/ 2 или Linux, а вот это вот - Must Die. А теперь человек произносит «мастдай» с усмешкой - и. . .	Красочные поля с номером страницы svg+background-image russiannick 04.11.2026 Красочные поля с номером страницы не менее важны чем в эпоху бумажных книг. Посему спешу представить почтеннейшей публике этот важный инструмент который эти поля и формирует. В процессе разработки. . .	Вступаем в новую фазу генерации favicons, векторную. russiannick 02.11.2026 Теперь нет нужды скрывать что используется простой svg. Исходный код изображения помещаем в поле и жмем кнопку. Исходник преобразуется в вид корректный для помещения в favicon или в url(). Нажатие. . .	Генератор паролей (вариант №4) Maks 01.11.2026 После публикации 3-го варианта генератора паролей, разослал его своим коллегам (с целью оценки), в итоге были получены следующие рекомендации: 1. Вернуть возможность использования знаков \| 1 l I;. . .
Генератор паролей (вариант №3) Maks 30.10.2026 Финальная версия генератора паролей 1С. Доработка решения в этот раз коснулась только визуальной части, а именно, добавлен реквизит ДопПараметры (тип Булево), который скрывает/ отображает реквизиты:. . .	Магическое мышление и магия, современная наука не отличима от магии (говорит ИИ Джемени) zorxor 30.10.2026 Джемени, расскажи, пожалуйста, что такое магическое мышление, что такое магия, почему современная наука чем-то напоминает магию? Фраза «Любая достаточно развитая технология неотличима от магии». . .	За какое время ИИ может подобрать пароль по хешу (рассказывает Джемени ИИ) zorxor 30.10.2026 Расскажи, Джемени, если известен хэш МД5, например, за сколько ИИ сможет подобрать соответствующий пароль? Искусственный интеллект (ИИ) может подобрать простой или средний по сложности пароль по. . .	Кто убил Suno? Почему наше солнышко погасло? (диалог с ИИ Джемени) zorxor 30.10.2026 Как убивали Suno. Хронология. «Убийство» музыкальной нейросети Suno — это затяжной процесс, в котором технологический хайп стартапа разбился о жесткую реальность судебных исков от гигантов. . .

@Антихакер32 1201 / 473 / 46 Регистрация: 06.01.2014 Сообщений: 1,797 Записей в блоге: 19
	12.07.2014, 23:30 [ТС]
	Спасибо.., вообщето я бы и сам догадался уже была такая мысль что при потере фокуса, переводить ссылку на того кто стал активным 0

Dragokas 18035 / 7738 / 892 Регистрация: 25.12.2011 Сообщений: 11,502 Записей в блоге: 16
	12.07.2014, 23:58
	Антихакер32, запили несколько тем с демонстрациями от простого к сложному по работе с динамическими контролами. Вот когда каждая тема будет вылизана до идеала - это будут самые лучшие готовые примеры. А пока то, что ты объяснил - я вообще ничего не понял. А то, что объяснил The trick, понял только слегка, потому что нет необходимости разбираться. Если бы ты взял этот кусочек кода и написал от и до - что почему и зачем - вот это было бы самым лучшим примером. А пока повторю - что мне хватает встроенного калькулятора Виндовс, благо умеет работать с разными СС. P.S. И здесь не раздел VBA. 0

@Антихакер32 1201 / 473 / 46 Регистрация: 06.01.2014 Сообщений: 1,797 Записей в блоге: 19
	13.07.2014, 00:14 [ТС]
	Ну понятно что можно стандартный калькулятор вызвать и все.. зато на основе новых знаний, полученных пусть и не самым приятным способом, я могу собирать различные объекты и в VB6 и в VBA причем в VBA, многие вещи могут уже сейчас быть очень востребованными а как вы хотели.. без практики, ничего бы не узнавалось небыло бы этих постов в споре рождается истина, как говорили наши дедушки 0

Dragokas 18035 / 7738 / 892 Регистрация: 25.12.2011 Сообщений: 11,502 Записей в блоге: 16
	13.07.2014, 00:41
	Антихакер32, пойми. Это ты можешь. А я на основе этих знаний не смогу. Какой-нибудь новичок - тем более. 3