怎么样算"1+2*3/4"的值

[silverblade]

一个变量里面存的是类似"1+2*3/4"这样的可以计算的四则运算题，用什么简单的办法可以得到结果。请注意，要简单。如果是把这个字符串分割开再算接别说了。

引申出一个问题。怎么样再VB中运行类似脚本的东西。
比如一个变量中保存有：
dim a as integer
a=10
print a
这样的VB代码，怎么样在程序中运行？

[tccth4091]

up 学习

[sunmaoyou]

也可以添加一个模块，可以计算任何代数式的值：
#If Win16 Then
Type RECT
Left As Integer
Top As Integer
Right As Integer
Bottom As Integer
End Type
#Else
Type RECT
Left As Long
Top As Long
Right As Long
Bottom As Long
End Type
#End If

'User and GDI Functions for Explode/Implode to work

#If Win16 Then
Declare Sub GetWindowRect Lib "User" (ByVal hWnd As Integer, lpRect As RECT)
Declare Function GetDC Lib "User" (ByVal hWnd As Integer) As Integer
Declare Function ReleaseDC Lib "User" (ByVal hWnd As Integer, ByVal hdc As Integer) As Integer
Declare Sub SetBkColor Lib "GDI" (ByVal hdc As Integer, ByVal crColor As Long)
Declare Sub Rectangle Lib "GDI" (ByVal hdc As Integer, ByVal X1 As Integer, ByVal Y1 As Integer, ByVal X2 As Integer, ByVal Y2 As Integer)
Declare Function CreateSolidBrush Lib "GDI" (ByVal crColor As Long) As Integer
Declare Function SelectObject Lib "GDI" (ByVal hdc As Integer, ByVal hObject As Integer) As Integer
Declare Sub DeleteObject Lib "GDI" (ByVal hObject As Integer)
#Else
Declare Function GetWindowRect Lib "user32" (ByVal hWnd As Long, lpRect As RECT) As Long
Declare Function GetDC Lib "user32" (ByVal hWnd As Long) As Long
Declare Function ReleaseDC Lib "user32" (ByVal hWnd As Long, ByVal hdc As Long) As Long
Declare Function SetBkColor Lib "gdi32" (ByVal hdc As Long, ByVal crColor As Long) As Long
Declare Function Rectangle Lib "gdi32" (ByVal hdc As Long, ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long) As Long
Declare Function CreateSolidBrush Lib "gdi32" (ByVal crColor As Long) As Long
Declare Function SelectObject Lib "user32" (ByVal hdc As Long, ByVal hObject As Long) As Long
Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long
#End If

'****************************************************************
'*Author: Carl Slutter
'*
'*Description:
'*The higher the "Movement", the slower the window
'*"explosion".
'*
'*Creation Date: Thursday 23 January 1997 2:27 pm
'*Revision Date: Thursday 23 January 1997 2:27 pm
'*
'*Version Number: 1.00
'****************************************************************

Sub ExplodeForm(F As Form, Movement As Integer)
Dim myRect As RECT
Dim formWidth%, formHeight%, i%, X%, Y%, Cx%, Cy%
Dim TheScreen As Long
Dim Brush As Long

GetWindowRect F.hWnd, myRect
formWidth = (myRect.Right - myRect.Left)
formHeight = myRect.Bottom - myRect.Top
TheScreen = GetDC(0)
Brush = CreateSolidBrush(F.BackColor)

For i = 1 To Movement
Cx = formWidth * (i / Movement)
Cy = formHeight * (i / Movement)
X = myRect.Left + (formWidth - Cx) / 2
Y = myRect.Top + (formHeight - Cy) / 2
Rectangle TheScreen, X, Y, X + Cx, Y + Cy
Next i

X = ReleaseDC(0, TheScreen)
DeleteObject (Brush)

End Sub


Public Sub ImplodeForm(F As Form, Direction As Integer, Movement As Integer, ModalState As Integer)
'****************************************************************
'*Author: Carl Slutter
'*
'*Description:
'*The larger the "Movement" value, the slower the "Implosion"
'*
'*Creation Date: Thursday 23 January 1997 2:42 pm
'*Revision Date: Thursday 23 January 1997 2:42 pm
'*
'*Version Number: 1.00
'****************************************************************

Dim myRect As RECT
Dim formWidth%, formHeight%, i%, X%, Y%, Cx%, Cy%
Dim TheScreen As Long
Dim Brush As Long

GetWindowRect F.hWnd, myRect
formWidth = (myRect.Right - myRect.Left)
formHeight = myRect.Bottom - myRect.Top
TheScreen = GetDC(0)
Brush = CreateSolidBrush(F.BackColor)

For i = Movement To 1 Step -1
Cx = formWidth * (i / Movement)
Cy = formHeight * (i / Movement)
X = myRect.Left + (formWidth - Cx) / 2
Y = myRect.Top + (formHeight - Cy) / 2
Rectangle TheScreen, X, Y, X + Cx, Y + Cy
Next i

X = ReleaseDC(0, TheScreen)
DeleteObject (Brush)

End Sub




'计算用户输入的表达式
'如 "3+2*2" 结果为 "7"

[sunmaoyou]

Public Function jisuan(GS As String) As String
Dim i, n As Integer
Dim TempGs, temp As String
Dim Vl() As String '操作数
Dim Vls As Integer '操作数的数目
Dim Si As Integer '上一操作符的位置
Dim Ads, Sus, Mus, Bys, Lks, Rks As Integer '操作符的数目
Dim Adp(), Mup(), Byp(), Lkp(), Rkp() As Integer '操作符的位置
Dim Adn(), Mun(), Byn() As Integer '操作符的排列次序
Dim Sig() As Integer '每一个操作符的位置

On Error GoTo Err
Do While True
ReDim Adp(Len(GS)), Mup(Len(GS)), Byp(Len(GS)) _
, Lkp(Len(GS)), Rkp(Len(GS)) As Integer
ReDim Adn(Len(GS)), Mun(Len(GS)), Byn(Len(GS)) _
, Lkn(Len(GS)), Rkn(Len(GS)), Sig(Len(GS)) As Integer

ReDim Vl(Len(GS))

If Len(GS) = 0 Then GoTo Err
If Mid(GS, Len(GS), 1) <> "#" Then

TempGs = GS
For i = 1 To Len(GS) '将减化加

If Mid(GS, i, 1) = "-" And i <> 1 Then
If Mid(GS, i - 1, 1) <> "+" And Mid(GS, i - 1, 1) <> "-" _
And Mid(GS, i - 1, 1) <> "*" And Mid(GS, i - 1, 1) <> "/" Then
TempGs = Mid(TempGs, 1, i - 1 + n) + "+" + Mid(GS, i)
n = n + 1
End If

End If
Next i
GS = TempGs

n = 0
For i = 1 To Len(GS) '处理负负得正
If Mid(GS, i, 1) = "-" Then
If Mid(GS, i + 1, 1) = "-" Then
TempGs = Mid(TempGs, 1, i - 1 - n) + Mid(GS, i + 2)
n = n + 2
End If
End If
Next i
GS = TempGs
GS = GS + "#"
End If

Vls = 1
Ads = 0: Sus = 0: Mus = 0: Bys = 0: Lks = 0: Rks = 0

For i = 1 To Len(GS)

Select Case Mid(GS, i, 1)
Case "+"
Ads = Ads + 1
Adp(Ads) = i
Adn(Ads) = Vls
Case "*"
Mus = Mus + 1
Mup(Mus) = i
Mun(Mus) = Vls
Case "/"
Bys = Bys + 1
Byp(Bys) = i
Byn(Bys) = Vls
Case "("
Lks = Lks + 1
Lkp(Lks) = i

Case ")"
Rks = Rks + 1
Rkp(Rks) = i

End Select

If Mid(GS, i, 1) = "+" Or Mid(GS, i, 1) = "*" Or _
Mid(GS, i, 1) = "/" Or Mid(GS, i, 1) = "#" Then

If Si + 1 = i And Mid(GS, i + 1, 1) <> "#" _
Then '操作符非法连续或以操作符开头
GoTo Err
Else
Si = i
End If

If Not IsNumeric(Vl(Vls)) And Mid(GS, i + 1, 1) <> "#" _
Then '操作数不是数字
GoTo Err
End If
Sig(Vls) = i
Vls = Vls + 1

Else
If Mid(GS, i, 1) <> "(" And Mid(GS, i, 1) <> ")" Then
Vl(Vls) = Vl(Vls) + Mid(GS, i, 1) '制作操作数
Else
If i <> 1 Then
If ((Mid(GS, i - 1, 1) = "(" And Mid(GS, i, 1) = ")") Or _
(Mid(GS, i - 1, 1) = ")" And Mid(GS, i, 1) = "(")) _
Then '判定括号前后符号的合法性
GoTo Err
End If
End If
End If
End If

Next i

If Lks <> Rks Then
GoTo Err '左右括号数是否匹配
End If

For i = 1 To Lks
If Lkp(i) > Rkp(i) Then GoTo Err '左右括号出现顺序错误
Next i

If Lks <> 0 Then '括号处理
Do While True
For i = Lks To 1 Step -1
For n = Rks To 1 Step -1
temp = jisuan(Mid(GS, Lkp(i) + 1, Rkp(n) - Lkp(i) - 1))
If temp <> "公式有错误" Then
GS = Mid(GS, 1, Lkp(i) - 1) + temp + Mid(GS, Rkp(n) + 1)
Exit Do
End If
Next n
Next i
If temp = "公式有错误" Then GoTo Err
'括号中有错误退出
Loop
Else
If Mus <> 0 Then '乘法处理
GS = Mid(GS, 1, Sig(Mun(1) - 1)) + Trim(Str(Val(Vl(Mun(1))) _
* Val(Vl(Mun(1) + 1)))) + Mid(GS, Val(Mup(1)) + Len(Vl(Mun(1) _
+ 1)) + 1)
Else
If Bys <> 0 Then '除法处理
GS = Mid(GS, 1, Sig(Byn(1) - 1)) + Trim(Str(Val(Vl(Byn(1))) _
/ Val(Vl(Byn(1) + 1)))) + Mid(GS, Val(Byp(1)) + Len(Vl(Byn(1) _
+ 1)) + 1)
Else
If Ads <> 0 Then '加法处理
GS = Trim(Str(Val(Vl(1)) + Val(Vl(2)))) + Mid(GS, Val(Adp(1)) _
+ Len(Vl(2)) + 1)
Else
jisuan = Mid(GS, 1, Len(GS) - 1)
Exit Function
End If
End If
End If
End If
Loop


Err:
jisuan = "公式有错误"

End Function

[viena]

弓虽！

[aaa2000]

做个记号

[pigpag]

我觉得这样的问题要自己考虑解决方法~~~~个人认为。

其实如果你真的想自己编这样的代码，一个下午就能编出PowerToys里面的计算功能了，并不难。

[pigpag]

我本人不推荐ScriptControl：1.慢 2.懒

当然，只是引用一处当然推荐使用。要是准备自己开发强大计算功能的，本人不推荐。

[rainstormmaster]

我本人不推荐ScriptControl：1.慢 2.懒

当然，只是引用一处当然推荐使用。要是准备自己开发强大计算功能的，本人不推荐

同意

[txlicenhe]

菜单"工程/引用/Microsoft Script Control 1.0"

Private Sub Command2_Click()
Dim Eval As New ScriptControl

Eval.Language = "VBScript"
MsgBox Eval.Eval("1+2*3/4")

Set Eval = Nothing
End Sub

[golden24kcn]

来晚了

[xiaohei728]

具然有这么多的方法真行呢
我第一次见这样的问题呢

值得收为已有

[daviddivad]

感谢您使用微软产品。

您可以利用Microsoft Script Control来实现这个功能。

首先，你需要在工程里引用一下Microsoft Script Control。然后加入一下代码：

Private Sub Form_Load()

Dim scr As New ScriptControl
Dim mycode As String

scr.Language = "vbscript"
mycode = "public function Test()" + vbCrLf
mycode = mycode + "MsgBox ""Hello VB""" + vbCrLf
mycode = mycode + "End function"

scr.AddCode (mycode)
scr.Eval ("Test()")

End Sub

这样，在字符串mycode里定义的函数Test()就会被调用了。

参考：

HOWTO: Use Script Control Modules and Procedures Collections
http://support.microsoft.com/default.aspx?scid=KB;EN-US;Q184745


- 微软全球技术中心 VB技术支持

本贴子以“现状”提供且没有任何担保，同时也没有授予任何权利。具体事项可参见使用条款
(http://support.microsoft.com/directory/worldwide/zh-cn/community/terms_chs.asp)。
为了为您创建更好的讨论环境，请参加我们的用户满意度调查
(http://support.microsoft.com/directory/worldwide/zh-cn/community/survey.asp?key=(S,49854782))。

[feiqinfeiwhw]

Dim aa(0 To 3) As String
Dim sngResult As Single
Private Sub Command1_Click()
Dim str As String
str = "1+2*3/4"
aa(0) = "+"
aa(1) = "-"
aa(2) = "*"
aa(3) = "/"
sngResult = 0
Call Un(str)
MsgBox sngResult
End Sub

Private Function Un(ByVal str As String) As Single
Dim str1(0 To 1) As String
Dim lngResult As Single
Dim intPos As Long
Dim intpos3 As Long
Dim intpos4 As Long
Dim lngLength As Long
Dim int1 As Single
Dim int2 As Single
Dim j As Integer
If str = "" Then Exit Function
intPos = InStr(1, str, aa(2))
j = 2
If intPos = 0 Then
j = 3
intPos = InStr(1, str, aa(3))
End If
If intPos = 0 Then
j = 0
intPos = InStr(1, str, aa(0))
End If
If intPos = 0 Then
j = 1
intPos = InStr(1, str, aa(1))
End If
If intPos = 0 Then Exit Function
lngLength = intPos
str1(0) = Left(str, intPos - 1)
str1(1) = Right(str, Len(str) - intPos)
If str1(0) <> "" Then
int1 = getId(str1(0))
Else
If aa(j) = "+" Or aa(j) = "-" Then
int1 = 0
Else
int1 = 1
End If
End If
If str1(1) <> "" Then
int2 = getId1(str1(1))
Else
If aa(j) = "+" Or aa(j) = "-" Then
int2 = 0
Else
int2 = 1
End If
End If
sngResult = Result(aa(j), int1, int2)
str = CStr(Result(aa(j), int1, int2))
If str1(0) <> "" Then str = str1(0) & str
If str1(1) <> "" Then str = str & str1(1)
If str1(1) = "" And str1(0) = "" Then Exit Function
Call Un(str)
End Function

Private Function getId(ByRef strstr As String) As Single
Dim i As Integer
Dim intpos1 As Long
Dim intpos2 As Long
For i = 0 To 3
intpos1 = InStr(1, strstr, aa(i))
If intpos1 > intpos2 Then intpos2 = intpos1
Next i
getId = CSng(Right(strstr, Len(strstr) - intpos2))
strstr = Left(strstr, intpos2)
If Len(strstr) = 1 Then
If strstr = "-" Then getId = -CSng(getId)
End If
End Function

Private Function getId1(ByRef strstr As String) As Single
Dim i As Integer
Dim intpos1 As Long
Dim intpos2 As Long
For i = 0 To 3
intpos1 = InStr(1, strstr, aa(i))
If intpos1 <> 0 And intpos2 = 0 Then intpos2 = intpos1
If intpos1 <> 0 And intpos1 < intpos2 Then intpos2 = intpos1
Next i
If intpos2 = 0 Then
getId1 = CSng(strstr)
strstr = ""
Else
getId1 = CSng(Left(strstr, intpos2 - 1))
strstr = Right(strstr, Len(strstr) - intpos2 + 1)
End If
End Function
Private Function Result(ByVal str As String, ByVal int1 As Single, ByVal int2 As Single) As Single
Select Case str
Case "+"
Result = int1 + int2
Case "-"
Result = int1 - int2
Case "*"
Result = int1 * int2
Case "/"
Result = int1 / int2
Case Else
End Select
End Function
可以用到任何算术式
sngresult存放的就是计算结果

[yxl3440]

up

[pigpag]

楼上一大段的代码的算法与我的不同。我认为用数组分析，不用函数递归，前途不好（功能上无法扩张，单目运算符不能实现）

[Mars.CN]

MsgBox Eval.Eval("1+2*3/4")

[goodname008]

' 这个办法简单易行，什么都不用引用。 :)

Option Explicit
Private Declare Function EbExecuteLine Lib "vba6.dll" (ByVal pStringToExec As Long, ByVal Unknownn1 As Long, ByVal Unknownn2 As Long, ByVal fCheckOnly As Long) As Long

Public Function ExecuteLine(sCode As String, Optional fCheckOnly As Boolean) As Boolean
ExecuteLine = EbExecuteLine(StrPtr(sCode), 0&, 0&, Abs(fCheckOnly)) = 0
End Function

Private Sub Command1_Click()
ExecuteLine "msgbox 1+2*3/4"
ExecuteLine "dim a as integer"
ExecuteLine "a = 10"
ExecuteLine "Print a"
End Sub

[luolovegui]

高！UP

[900126]

虽然不用引用，但计算速度要满诶，好象用script速度要快些（1：0.25）
看来各有优点。
自编程序来计算在特殊需要时，是有优点的（比如简易运算的速度快），但做通用运算时，还是使用上述两种方法为好。我用了多年自编的处理程序，看来也该换换了。
不过，有自己编写的能力还是必要的。一些企业在录用考试时，就用过这个程序。

[900126]

是2.5:1