引申出一个问题。怎么样再VB中运行类似脚本的东西。
比如一个变量中保存有:
dim a as integer
a=10
print a
这样的VB代码,怎么样在程序中运行?
...全文
9229打赏收藏
怎么样算"1+2*3/4"的值
一个变量里面存的是类似"1+2*3/4"这样的可以计算的四则运算题,用什么简单的办法可以得到结果。请注意,要简单。如果是把这个字符串分割开再算接别说了。 引申出一个问题。怎么样再VB中运行类似脚本的东西。 比如一个变量中保存有: dim a as integer a=10 print a 这样的VB代码,怎么样在程序中运行?
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
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存放的就是计算结果
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
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
也可以添加一个模块,可以计算任何代数式的值:
#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
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
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