In mean time I've extended the simple version above with some conversion options, like miles to kms, foot to meters, gallons to liters, currencies to euros and vice-versa. Here's the code for those who are interested. Also I've changed the name from cc to ccalc, because of conflicts in Linux with the C compiler. Calc gives a conflict in Windows with the graphical calculator, therefore ccalc is the new name.
Code: Select all
' Version 2022-07-12 Added percentage variable and more constants (line 50+) | Prozent variabele hinzugefügt und noch mehr Konstanten (Zeile 50+)
' Added inch variable in predefined constants (line 49) | Inch varabele hinzugefügt in vordefinierte Konstanten (Zeile 49)
' Version 2013-10-26 Original version from FreeBasic.de | Originale Version von FreeBasic.de https://www.freebasic-portal.de/code-beispiele/mathematik/parser-fuer-algebraische-ausdruecke-expression-parser-282.html
namespace Calculate
enum Errors
NoError = 0
ErrorNoValue
ErrorMissingBrace
ErrorMissingNumber
ErrorWrongDecimalPoint
ErrorWrongExponent
ErrorIllegalSymbol
ErrorNotANumber
ErrorUndefinedFunction
ErrorUndefinedVariable
ErrorOverwriteFunction
ErrorIllegalValue
end enum
type variables
as string id
as double value
declare constructor
declare constructor(i as string, v as double)
end type
constructor variables
end constructor
constructor variables(i as string = "", v as double = 0)
this.id = i
this.value = v
end constructor
dim shared as variables globalVar(), localVar()
dim shared as Errors CalcError
dim shared as string CalcErrorTerm
const NaN = -sqr(-1)
end namespace
declare function calc(t as string) as double
declare function calcPart(t as string) as double
declare function calcFunction(func as string, value as string) as double
declare function calcGetVar(variable as string) as double
declare function calcSetVar overload (variable as string, value as string) as double
declare sub calcSetVar(variable as string, value as double)
' Predefined constants | Vordefinierte Konstanten
calcSetVar "e", 2.718281828459045
calcSetVar "pi", 3.141592653589793
calcSetVar "inch", 2.54
calcSetVar "percent", 0.01
calcSetVar "foot", 0.3048
calcSetVar "gallon", 3.79
calcSetVar "mile", 1.609344
calcSetVar "kg", 9.81
calcSetVar "pound", 0.45359
calcSetVar "yard", 0.9144
calcSetVar "amd", 0.862
calcSetVar "gbp", 1.128
calcSetVar "rub", 0.0147
calcSetVar "cny", 0.129
calcSetVar "plz", 0.236
calcSetVar "try", 0.225
calcSetVar "hfl", 0.4545454545454545
calcSetVar "grm", 0.5181818181818181
function calc(t as string) as double
dim as string term
dim as integer seperator = 0, lastSeperator, position = 0, newposition = 0
dim as double value
erase Calculate.localVar
Calculate.CalcError = 0
Calculate.CalcErrorTerm = ""
do
lastSeperator = seperator
seperator = instr(seperator+1, t, ";")
if seperator then
term = lcase(trim(mid(t, lastSeperator+1, seperator-lastSeperator-1), any chr(9, 32)))
else
term = lcase(trim(mid(t, lastSeperator+1), any chr(9, 32)))
end if
if term = "" then
Calculate.CalcError = Calculate.ErrorNoValue
return Calculate.NaN
end if
' Check groups of variables | Setzen von Variablen pruefen
if term[0] > 96 and term[0] < 123 then
do while position < len(term)
select case term[position]
case 97 to 122
position += 1
case 9, 32
if newposition = 0 then newposition = position
position += 1
case 61 ' =
if newposition = 0 then newposition = position
value = calcSetVar(left(term, newposition), mid(term, position+2))
continue do, do
case else
exit do
end select
loop
end if
value = calcPart(term)
if Calculate.CalcError then return Calculate.NaN
loop until seperator = 0
return value
end function
function calcPart(t as string) as double
dim as string term = trim(t, any chr(9, 32))
dim as double tempValue, tempValue2, tempValue3
if term = "" then
Calculate.CalcError = Calculate.ErrorNoValue
return Calculate.NaN
end if
dim as integer position = 0, newposition = 0, count = 0, lastChar = 0
' Seperate semicolons | Klammern abtrennen
do while position < len(term)
select case term[position]
case 97 to 122
if lastChar = 0 then lastChar = position+1
case 9, 32
' nothing to do ... | nichts aus zu führen ...
case 40 ' (
count = 1
newposition = position+1
do while newposition < len(term)
select case term[newposition]
case 40 ' (
count += 1
case 41 ' )
count -= 1
if count = 0 then exit do
end select
newposition += 1
loop
if count > 0 then
Calculate.CalcError = Calculate.ErrorMissingBrace
Calculate.CalcErrorTerm = term
return Calculate.NaN
end if
if lastChar then
term = left(term, lastChar-1) _
& calcFunction(mid(term, lastChar, position-lastChar+1), mid(term, position+2, newposition-position-1)) _
& mid(term, newposition+2)
else
tempValue = calcPart(mid(term, position+2, newposition-position-1))
if Calculate.CalcError then return Calculate.NaN
term = left(term, position) & tempValue & mid(term, newposition+2)
end if
case else
lastChar = 0
end select
position += 1
loop
' Check variables | Variablen pruefen
if term = "+" or term = "-" then ' ensuring no + or - is solitary | sicherstellen, dass +/- nicht allein steht
Calculate.CalcError = Calculate.ErrorIllegalSymbol
Calculate.CalcErrorTerm = term
end if
tempValue = iif(term[0] = 43 or term[0] = 45, 2, 1) ' mark? | Vorzeichen?
position = tempValue
if term[position-1] > 96 and term[position-1] < 123 then
do while position < len(term)
select case term[position]
case 97 to 122
position += 1
continue do
case 9, 32, 42, 43, 45, 47, 92, 94 ' split sign | Trennzeichen
exit do
case else
Calculate.CalcError = Calculate.ErrorIllegalSymbol
Calculate.CalcErrorTerm = term
return Calculate.NaN
end select
position += 1
loop
tempValue = calcGetVar(mid(term, tempValue, position-tempValue+1))
if Calculate.CalcError then return Calculate.NaN
if term[0] = 45 then tempValue = -tempValue
term = tempValue & mid(term, position+1)
end if
' Separate calculations | Strichrechnung trennen
position = 1
dim as integer lastSymbol = term[0]
do while position < len(term)
select case lastSymbol
case 42, 47, 92, 94 ' *, /, \, ^
lastSymbol = term[position]
position += 1
continue do ' There's a mark envolved | Es handelt sich um ein Vorzeichen
end select
select case term[position]
case 43 ' +
if position > 1 andalso (term[position-1] = 69 or term[position-1] = 101) _
andalso (term[position-2] > 47 and term[position-2] < 58) then position += 1 : continue do
if lastSymbol = 43 or lastSymbol = 45 then
Calculate.CalcError = Calculate.ErrorIllegalSymbol
Calculate.CalcErrorTerm = term
return Calculate.NaN
end if
tempValue = calcPart(left(term, position))
if Calculate.CalcError then return Calculate.NaN
tempValue2 = calcPart(mid(term, position+2))
if Calculate.CalcError then return Calculate.NaN
return tempValue + tempValue2
case 45 ' -
if position > 1 andalso (term[position-1] = 69 or term[position-1] = 101) _
andalso (term[position-2] > 47 and term[position-2] < 58) then position += 1 : continue do
if lastSymbol = 43 or lastSymbol = 45 then
Calculate.CalcError = Calculate.ErrorIllegalSymbol
Calculate.CalcErrorTerm = term
return Calculate.NaN
end if
tempValue = calcPart(left(term, position))
if Calculate.CalcError then return Calculate.NaN
tempValue2 = calcPart("-" & trim(mid(term, position+2), any chr(9, 32)))
if Calculate.CalcError then return Calculate.NaN
return tempValue + tempValue2
end select
lastSymbol = term[position]
position += 1
loop
' Seperate decimals | Punktrechnung trennen
position = 1
do while position < len(term)
select case term[position]
case 42 ' *
tempValue = calcPart(left(term, position))
if Calculate.CalcError then return Calculate.NaN
tempValue2 = calcPart(mid(term, position+2))
if Calculate.CalcError then return Calculate.NaN
return tempValue * tempValue2
case 47 ' /
tempValue = calcPart(left(term, position))
if Calculate.CalcError then return Calculate.NaN
tempValue2 = calcPart(mid(term, position+2))
if Calculate.CalcError then return Calculate.NaN
if tempValue2 = 0 then
Calculate.CalcError = Calculate.ErrorIllegalValue
Calculate.CalcErrorTerm = term
return Calculate.NaN
end if
return tempValue / tempValue2
case 92 ' \
tempValue = calcPart(left(term, position))
if Calculate.CalcError then return Calculate.NaN
tempValue2 = calcPart(mid(term, position+2))
if Calculate.CalcError then return Calculate.NaN
if tempValue2 = 0 then
Calculate.CalcError = Calculate.ErrorIllegalValue
Calculate.CalcErrorTerm = term
return Calculate.NaN
end if
return tempValue \ tempValue2
end select
position += 1
loop
' Seperate powering units | Potenzrechnung trennen
position = 1
do while position < len(term)
select case term[position]
case 94 ' ^
tempValue = calcPart(left(term, position))
if Calculate.CalcError then return Calculate.NaN
tempValue2 = calcPart(mid(term, position+2))
if Calculate.CalcError then return Calculate.NaN
return tempValue ^ tempValue2
end select
position += 1
loop
' Parse values | Zahlenwert parsen
dim as integer sign = 1, decpoint = 0, exponent = 0
if term[0] = 45 then
if len(term) = 1 then
Calculate.CalcError = Calculate.ErrorMissingNumber
Calculate.CalcErrorTerm = term
return Calculate.NaN
end if
sign = -1
position = 1
else
position = 0
end if
do while position < len(term)
select case term[position]
case 48 to 57 ' 0 - 9
position += 1
continue do
case 46 ' .
if decpoint or exponent then
Calculate.CalcError = Calculate.ErrorWrongDecimalPoint
Calculate.CalcErrorTerm = term
return Calculate.NaN
end if
decpoint = -1
case 69, 101 ' e, E
if exponent orelse position = len(term)-1 then
Calculate.CalcError = Calculate.ErrorWrongExponent
Calculate.CalcErrorTerm = term
return Calculate.NaN
end if
position += 1
select case term[position]
case 48 to 57 ' 0 - 9
position += 1
continue do
case 43, 45
if position = len(term)-1 then
Calculate.CalcError = Calculate.ErrorWrongExponent
Calculate.CalcErrorTerm = term
return Calculate.NaN
end if
if term[position+1] < 48 or term[position+1] > 57 then
Calculate.CalcError = Calculate.ErrorWrongExponent
Calculate.CalcErrorTerm = term
return Calculate.NaN
end if
position += 2
case else
Calculate.CalcError = Calculate.ErrorWrongExponent
Calculate.CalcErrorTerm = term
return Calculate.NaN
end select
exponent = -1
case else
Calculate.CalcError = Calculate.ErrorNotANumber
Calculate.CalcErrorTerm = mid(term, position+1)
return Calculate.NaN
end select
position += 1
loop
return val(term)
end function
function calcFunction(func as string, value as string) as double
dim as double v = calcPart(value)
if Calculate.CalcError then return Calculate.NaN
select case func
case "sin"
return sin(v)
case "cos"
return cos(v)
case "tan"
return tan(v)
case "asin"
if v < -1 or v > 1 then
Calculate.CalcError = Calculate.ErrorIllegalValue
Calculate.CalcErrorTerm = "asin(" & v & ")"
return Calculate.NaN
end if
return asin(v)
case "acos"
if v < -1 or v > 1 then
Calculate.CalcError = Calculate.ErrorIllegalValue
Calculate.CalcErrorTerm = "acos(" & v & ")"
return Calculate.NaN
end if
return acos(v)
case "atan", "atn"
return atn(v)
case "abs"
return abs(v)
case "sgn"
return sgn(v)
case "sqr"
if v < 0 then
Calculate.CalcError = Calculate.ErrorIllegalValue
Calculate.CalcErrorTerm = "sqr(" & v & ")"
return Calculate.NaN
end if
return sqr(v)
case "exp"
return exp(v)
case "log", "ln"
if v <= 0 then
Calculate.CalcError = Calculate.ErrorIllegalValue
Calculate.CalcErrorTerm = func & "(" & v & ")"
return Calculate.NaN
end if
return log(v)
case "int"
return int(v)
case "cint"
return cint(v)
case "fix"
return fix(v)
case "frac"
return frac(v)
end select
Calculate.CalcError = Calculate.ErrorUndefinedFunction
Calculate.CalcErrorTerm = func
return Calculate.NaN
end function
function calcGetVar(variable as string) as double
for i as integer = 0 to ubound(Calculate.localVar)
if Calculate.localVar(i).id = variable then return Calculate.localVar(i).value
next
for i as integer = 0 to ubound(Calculate.globalVar)
if Calculate.globalVar(i).id = variable then return Calculate.globalVar(i).value
next
Calculate.CalcError = Calculate.ErrorUndefinedVariable
Calculate.CalcErrorTerm = variable
return Calculate.NaN
end function
function calcSetVar(variable as string, value as string) as double
select case variable
case "sin", "cos", "tan", "asin", "acos", "atan", "atn", "abs", "sgn", "sqr", _
"exp", "log", "ln", "int", "cint", "fix", "frac"
Calculate.CalcError = Calculate.ErrorOverwriteFunction
Calculate.CalcErrorTerm = variable
return Calculate.NaN
end select
dim as double ret = calcPart(value)
if Calculate.CalcError then return Calculate.NaN
if ubound(Calculate.localVar) < 0 then
redim Calculate.localVar(0)
Calculate.localVar(0) = Calculate.variables(variable, ret)
else
for i as integer = 0 to ubound(Calculate.localVar)
if Calculate.localVar(i).id = variable then Calculate.localVar(i).value = ret : return ret
next
redim preserve Calculate.localVar(ubound(Calculate.localVar)+1)
Calculate.localVar(ubound(Calculate.localVar)) = Calculate.variables(variable, ret)
end if
return ret
end function
sub calcSetVar(variable as string, value as double)
select case variable
case "sin", "cos", "tan", "asin", "acos", "atan", "atn", "abs", "sgn", "sqr", _
"exp", "log", "ln", "int", "cint", "fix", "frac"
Calculate.CalcError = Calculate.ErrorOverwriteFunction
Calculate.CalcErrorTerm = variable
exit sub
end select
if ubound(Calculate.globalVar) < 0 then
redim Calculate.globalVar(0)
Calculate.globalVar(0) = Calculate.variables(variable, value)
else
for i as integer = 0 to ubound(Calculate.globalVar)
if Calculate.globalVar(i).id = variable then Calculate.globalVar(i).value = value : exit sub
next
redim preserve Calculate.globalVar(ubound(Calculate.globalVar)+1)
Calculate.globalVar(ubound(Calculate.globalVar)) = Calculate.variables(variable, value)
end if
end sub
I hope you all are happy with this solution.
Perhaps this can be posted as a project now since it has become a complete working tool?