ja sam poceo da pisem modul koji bi zamenio .Eval() funkciju script controle (bas za ovakve slucajeve, gde treba samo izracunati izraz) da ne bi bespotrebno vukao .ocx-ove
elem, kod je jos bugovit (problemi sa zagradama se jave ponekad :p) ali moze da prodje.
ako neko ima vremena nek se pozabavi malo sa ovim da doda logicke operacije i shl i shr pozto ja izgleda necu imati vremena da zavrsim ovo...
Code:
Option Explicit
Public Function Calc(Expression As String) As Double
Dim num1 As String
Dim num2 As String
Dim num3 As String
Dim op1 As String
Dim op2 As String
Dim i As Long
Dim l As Long
Dim s As String
num1 = ""
num2 = ""
num3 = ""
op1 = ""
op2 = ""
Expression = Replace$(Expression, " ", "")
For i = 1 To Len(Expression)
s = Mid$(Expression, i, 1)
If s = "(" Then
l = InStrRev(Expression, ")") - i - 1
If Len(op1) = 0 Then
If Len(num1) = 0 Then
num1 = CStr(Calc(Mid$(Expression, i + 1, l)))
Else
num2 = CStr(Calc(Mid$(Expression, i + 1, l)))
End If
Else
If Len(num2) = 0 Then
num2 = CStr(Calc(Mid$(Expression, i + 1, l)))
Else
num3 = CStr(Calc(Mid$(Expression, i + 1, l)))
End If
End If
i = i + l + 1
Else
If IsNumeric(s) Or s = "." Then
If Len(op1) = 0 Then
num1 = num1 & s
Else
If Len(op2) = 0 Then
num2 = num2 & s
Else
num3 = num3 & s
End If
End If
Else
If InStr(1, "+-/*\^#", s) < 1 Then
Call MsgBox("Invalid char: " & s, vbCritical, "Error")
Calc = 0
Exit Function
Else
If Len(op1) > 0 Then
If Len(op2) > 0 Then
Select Case biggerPriority(op1, op2)
Case 0, 1
num1 = doCalc(doCalc(Val(num1), _
Val(num2), op1), Val(num3), op2)
Case 2
num1 = doCalc(Val(num1), _
doCalc(Val(num2), Val(num3), op2), op1)
End Select
num2 = ""
num3 = ""
op1 = ""
op2 = ""
i = i - 1
Else
op2 = s
End If
Else
op1 = s
End If
End If
End If
End If
Next
If Len(op1) = 0 Then
Calc = Val(num1)
Else
If Len(op2) = 0 Then
If Len(num2) = 0 Then
Call MsgBox("Syntax error.", vbCritical, "Error")
Else
Calc = doCalc(Val(num1), Val(num2), op1)
End If
Else
If Len(num3) = 0 Then
Call MsgBox("Syntax error.", vbCritical, "Error")
Else
Select Case biggerPriority(op1, op2)
Case 0, 1
Calc = doCalc(doCalc(Val(num1), Val(num2), op1), Val(num3), op2)
Case 2
Calc = doCalc(Val(num1), doCalc(Val(num2), Val(num3), op2), op1)
End Select
End If
End If
End If
End Function
Private Function doCalc(n1 As Double, n2 As Double, op As String) As Double
'treba jos da dodam:
' && - AND operacija
' || - OR operacija
' % - XOR operacija
' ! - NOT operacija
' << - shl operacija (shuffle left)???
' >> - shr operacija (shuffle right)???
Select Case op
Case "+" 'addition
doCalc = n1 + n2
Case "-" 'substraction
doCalc = n1 - n2
Case "/" 'division
doCalc = n1 / n2
Case "*" 'multiply
doCalc = n1 * n2
Case "^" 'power
doCalc = n1 ^ n2
Case "#" 'root
doCalc = n1 ^ (1 / n2)
Case "\" 'integer division
doCalc = n1 \ n2
Case Else
doCalc = 0
Call MsgBox("Syntax error.", vbCritical, "Error")
End Select
End Function
Private Function biggerPriority(op1 As String, op2 As String) As Integer '0/1/2
Dim o1 As Integer
Dim o2 As Integer
Dim i As Integer
Dim ops() As String
ops = Split("+- */\ ^#", " ")
For i = LBound(ops) To UBound(ops)
If InStr(1, ops(i), op1) > 0 Then o1 = i
If InStr(1, ops(i), op2) > 0 Then o2 = i
Next
Select Case True
Case o1 = o2
biggerPriority = 0 'same priority
Case o1 > o2
biggerPriority = 1 'operand1 has bigger priority then operand2
Case o1 < o2
biggerPriority = 2 'operand2 has bigger priority then operand1
End Select
End Function
[Ovu poruku je menjao krckoorascic dana 13.09.2005. u 02:51 GMT+1]