# 这是魔术师朋友,给我写的计算器代码,可惜我看不懂?

xuen30 2007-09-11 09:43:58
''''窗体上画个 text1 text2 Command1

''在text1 里面输入要算得数如 10*(10+2*(10+10))

''aa,a,a,a,a,a,a,,a,a,ajdflkefjesljflfjweilrfefj

Dim a() As String
Dim k As Single
Dim B() As String

Private Sub Command1_Click()

ReDim a(0) '根据你式子长短定
Dim B1 As String
B1 = Text1.Text

Dim i As Integer, j As Integer, Y As Integer, z As Integer

Dim d1 As Boolean
For i = 1 To Len(B1)

If Asc(Mid(B1, i, 1)) >= 48 And Asc(Mid(B1, i, 1)) <= 57 Then
ReDim Preserve a(j)
a(j) = a(j) & Mid(B1, i, 1)
d1 = False
Else

If d1 = False Then j = j + 1
d1 = True
ReDim Preserve a(j)
a(j) = Mid(B1, i, 1)
j = j + 1
End If

Next

Dim q As Integer
i = 0
Do While i <= UBound(a())
i = i + 1
If i > UBound(a()) Then Exit Do
Select Case a(i)

Case "("
q = i

Case ")"

Call Jisuan(q + 1, i - 1, a(q))
For j = q + 1 To i
a(j) = ""
Next

Y = 0
GO8:
For j = 0 To UBound(a()) - 1

If a(j) = "" Then
a(j) = a(j + 1)
a(j + 1) = ""
If j = UBound(a()) - 1 Then Exit For

Else
Y = j
End If
' j = j + 1
Next

For z = Y + 1 To UBound(a())
If a(z) <> "" Then GoTo GO8
Next

ReDim Preserve a(Y)
If a(UBound(a())) = "" Then ReDim Preserve a(UBound(a()) - 1)

i = 0
Case ""

End Select

Loop
Dim f As String
' f = a(0) + a(1) + a(2) + a(3) + a(4) + a(5) + a(6) + a(7)
Call Jisuan(0, UBound(a()), f)

Text2.Text = f
k = 0
ReDim a(0)
ReDim B(0)
End Sub

Private Sub Jisuan(m As Integer, m1 As Integer, a2 As String)

ReDim B(0)
Dim i As Integer, j As Integer

For i = m To m1 - 1

Select Case a(i)

Case "+"
If (i - m) < 2 Then GoTo Go3
If a(i - 2) = "+" Or a(i - 2) = "-" Then
Go3:
j = j + 1
ReDim Preserve B(j)
B(j) = a(i - 1)
j = j + 1
ReDim Preserve B(j)
B(j) = a(i)
If i = m1 - 1 Then
j = j + 1
ReDim Preserve B(j)
B(j) = a(i + 1)
End If
Else
j = j + 1
ReDim Preserve B(j)
B(j) = a(i)
If i = m1 - 1 Then
j = j + 1
ReDim Preserve B(j)
B(j) = a(i + 1)
End If
End If
Case "-"
If (i - m) < 2 Then GoTo Go4
If a(i - 2) = "+" Or a(i - 2) = "-" Then
Go4:
j = j + 1
ReDim Preserve B(j)
B(j) = a(i - 1)
j = j + 1
ReDim Preserve B(j)
B(j) = a(i)
If i = m1 - 1 Then
j = j + 1
ReDim Preserve B(j)
B(j) = a(i + 1)
End If
Else
j = j + 1
ReDim Preserve B(j)
B(j) = a(i)
If i = m1 - 1 Then
j = j + 1
ReDim Preserve B(j)
B(j) = a(i + 1)
End If
End If
Case "*"
If (i - m) < 2 Then GoTo GO1
If a(i - 2) = "/" Or a(i - 2) = "*" Then

B(UBound(B())) = Str(Val(B(UBound(B()))) * Val(a(i + 1)))
Else
GO1:
j = j + 1
ReDim Preserve B(j)
B(j) = Str(Val(a(i - 1)) * Val(a(i + 1)))
End If

Case "/"

If (i - m) < 2 Then GoTo GO2
If a(i - 2) = "/" Or a(i - 2) = "*" Then

B(UBound(B())) = Str(Val(B(UBound(B()))) / Val(a(i + 1)))
Else

GO2:
j = j + 1
ReDim Preserve B(j)
B(j) = Str(Val(a(i - 1)) / Val(a(i + 1)))
End If

End Select
Next

Call Jisuan1(a2)
End Sub
Private Sub Jisuan1(a2 As String)
' k = B(0) & B(1) & B(2) & B(3)

For i = 2 To UBound(B()) - 1
Select Case B(i)

Case "+"
h = h + Val(B(i + 1))
Case "-"
h = h - Val(B(i + 1))
End Select
Next
a2 = Str(Val(B(1)) + h)

End Sub

'工作一下午为这道小题，唉。。。摸发誓 zfc775

...全文
135 回复 打赏 收藏 举报

7617

VB 基础类

2007-09-11 09:43