Date: 02-16-2022
Return to Index
created by gbSnippets
'Primary Code:
'Credit: Jean-Pierre Leroy (Jan, 2010)
'See the three functions below
'Compilable Example: (Jose Includes)
'Note the use of () to surround variable values. This is needed to allow
'for the use of negative values.
#Compiler PBWin 9, PBWin 10
#Compile EXE
#Dim All
%Unicode=1
#Include "Win32API.inc"
Global hDlg as DWord
Function PBMain() As Long
Dialog New Pixels, 0, "Test Code",300,300,200,200, %WS_OverlappedWindow To hDlg
Control Add Button, hDlg, 100,"Push", 50,10,100,20
Dialog Show Modal hDlg Call DlgProc
End Function
CallBack Function DlgProc() As Long
If CB.Msg = %WM_Command AND CB.Ctl = 100 AND CB.Ctlmsg = %BN_Clicked Then
Local x,y As Single, Expr As String
x = 5 : y = 5
Expr = "x*x + y*y"
Replace "x" With "(" + Str$(x) + ")" In Expr
Replace "y" With "(" + Str$(y) + ")" In Expr
MsgBox Str$(Evaluate(Expr))
End If
End Function
Function Evaluate(ByVal pExpression As String) As Single
Local lExpression As String
lExpression = PrepExpNum(pExpression) ' PREPare the NUMerical EXPexpression before the evaluation
Function = EvalExpNum(lExpression)
End Function
Function PrepExpNum(ByRef pExpression As String) As String
Local lNewExpression As String
lNewExpression = UCase$(Trim$(pExpression))
Replace "LOG10" With "LOGTEN" In lNewExpression
Replace "LOG2" With "LOGTWO" In lNewExpression
Replace "EXP10" With "EXPTEN" In lNewExpression
Replace "EXP2" With "EXPTWO" In lNewExpression
Replace "PI" With "3.14159" In lNewExpression
Replace "-" With "_" In lNewExpression ' to avoid any confusion with a negative value
Function = lNewExpression
End Function
Function EvalExpNum(ByVal pExpression As String) As Single 'Extended
Local lOpenParentheseStart, lOpenParentheseCounter, lCloseParentheseCounter As Long
Local lCurrentPos, lI, lPosOperator, lLeftOperandStart As Long
Local lleftOperandEnd, lRightOperandStart, lRightOperandEnd As Long
Local lEval, lLeftOperand, lRightOperand As Single 'Extended
Do
lOpenParentheseCounter = 0 : lCloseParentheseCounter = 0 'reset the parentheses counters
lOpenParentheseStart = Instr(pExpression, "(") 'search for a open parenthese "(" in the expression
If lOpenParentheseStart <> 0 Then 'only if we find a open parenthese "(" in the expression
lOpenParentheseCounter = 1 'initialize the open parenthese counter to 1
lCurrentPos = lOpenParentheseStart 'we start at the open parenthese
Do
Incr lCurrentPos 'increment the current position
If Mid$(pExpression, lCurrentPos, 1) = ")" Then Incr lCloseParentheseCounter ' to count the number of parentheses
If Mid$(pExpression, lCurrentPos, 1) = "(" Then Incr lOpenParentheseCounter
Loop Until lOpenParentheseCounter = lCloseParentheseCounter
pExpression = Left$(pExpression,lOpenParentheseStart-1)+ _ 'recursive call to EvalExpNum
Format$(EvalExpNum(Mid$(pExpression,lOpenParentheseStart+1,lCurrentPos-lOpenParentheseStart-1)))+ _
Right$(pExpression,-lCurrentPos)
Else
Data "ATN", "COS", "SIN", "TAN", "LOGTEN", "LOGTWO", "LOG", "EXPTEN"
Data "EXPTWO", "EXP", "SQR", "ABS", "^", "*", "/", "\", "MOD", "_", "+"
For lI = 1 To Datacount ' check all the Operators/Functions that could be used in the numerical expression
Do ' examines all the occurences of the operator/function
lPosOperator = Instr(pExpression,Read$(lI))
If lPosOperator <> 0 Then ' only if we find the Operator/Function
lLeftOperandEnd = lPosOperator-1 ' search the start/end of the left operand
lCurrentPos = lPosOperator
Do
Decr lCurrentPos ' decrement current pos
If lCurrentPos < 1 Then Exit Loop ' if we are out of the string
Loop Until Instr(" 0123456789.-",Mid$(pExpression, lCurrentPos, 1)) = 0
lLeftOperandStart = lCurrentPos+1
lRightOperandStart = lPosOperator+Len(Read$(lI)) ' search the start/end of the right operand
lCurrentPos = lPosOperator+Len(Read$(lI))-1
Do
Incr lCurrentPos ' decrement current pos
If lCurrentPos > Len(pExpression) Then Exit Loop ' if we are out of the string
Loop Until Instr(" 0123456789.-",Mid$(pExpression, lCurrentPos, 1)) = 0
lRightOperandEnd = lCurrentPos - 1
lLeftOperand = Val(Trim$(Mid$(pExpression,lLeftOperandStart ,lLeftOperandEnd -lLeftOperandStart +1))) ' extract the operands removing spaces
lRightOperand = Val(Trim$(Mid$(pExpression,lRightOperandStart,lRightOperandEnd-lRightOperandStart+1))) ' extract the operands removing spaces
Select Case Read$(lI) ' depending of the Operator/Function
Case "ATN" : lEval = Atn(lRightOperand)
Case "COS" : lEval = Cos(lRightOperand)
Case "SIN" : lEval = Sin(lRightOperand)
Case "TAN" : lEval = Tan(lRightOperand)
Case "LOGTEN" : lEval = Log10(lRightOperand)
Case "LOGTWO" : lEval = Log2(lRightOperand)
Case "LOG" : lEval = Log(lRightOperand)
Case "EXPTEN" : lEval = Exp10(lRightOperand)
Case "EXPTWO" : lEval = Exp2(lRightOperand)
Case "EXP" : lEval = Exp(lRightOperand)
Case "SQR" : lEval = Sqr(lRightOperand)
Case "ABS" : lEval = ABS(lRightOperand)
Case "^" : lEval = lLeftOperand ^ lRightOperand
Case "*" : lEval = lLeftOperand * lRightOperand
Case "/" : lEval = lLeftOperand / lRightOperand
Case "\" : lEval = lLeftOperand \ lRightOperand
Case "MOD" : lEval = lLeftOperand Mod lRightOperand
Case "_" : lEval = lLeftOperand - lRightOperand
Case "+" : lEval = lLeftOperand + lRightOperand
End Select
lEval = Round(lEval, 2) 'round the evaluation to 6 decimal places to avoid scientific notation (E-)
pExpression = Left$(pExpression,lLeftOperandStart-1)+Format$(lEval)+Right$(pExpression,-lRightOperandEnd) 'place the result of the evaluation in the string
End If
Loop Until lPosOperator = 0
Next lI
Function = Val(pExpression) 'to evaluate the final expression
End If
Loop Until lOpenParentheseStart = 0
End Function
'gbs_00570
'Date: 03-10-2012
http://www.garybeene.com/sw/gbsnippets.htm