Wenn´s nur um die Berechnung mathematischer Ausdrücke innerhalb Deines Programms geht dann klappt´s auch hiermit:
Code: Alles auswählen
;Modul Calc Version 1.1 vom 27.05.2007
#PB_Vers = "4.20"
;
;Funktion: Ausrechnen eines mathematischen Ausdruckes
;
;Aufruf: Wert$ = Calc(Formel$) mathem. Formel ausrechnen
; wobei Formel$ = Ausdruck zur RechenVorschrift, kann neben konkreten Zahlen
; (Komma kann sowohl . als auch , sein) folgende Zeichen ent=
; halten:
; + Addition
; - Subtraktion
; * Multiplikation (auch x oder X mglich)
; / Division (auch : möglich)
; % Modulo (Divisions-Rest)
; ( ) Klammerungen
; !x Fakultt (1*2*3...*x)
;
; ABS(x) Betrag (immer positiv)
; SQR(x) Quadrat-Wurzel
; LOG(x) Logerithmus
; INV(x) Inversion (1/x)
; LN(x) natürl. Logorithmus
;
; SIN(x) Sinus
; COS(x) Cosinus
; TAN(x) Tangens
; ASIN(x) Acussinus
; ACOS(x) Acuscosinus
; ATAN(x) Acustangens
;
; & UND-Verknüpfung
; | ODER-Verknüpfung
; > größer
; < kleiner
; = gleich
; #MEM, #MEM1...#MEM9: Speicher-Zugriffe
; Wurde ein fehlerhafter Ausdruck angegeben, so liefert diese Funktion
; "ERROR", ansonsten das Ergebiss als nummerischen String (Komma ist ".")
#EVAL_NUMS = "0123456789" ;Die Ziffern von 0 bis 9
#EVAL_GENAUGK = 65 ;Genauigkeit fr StrF() - 65 sollte eigentlich gengen, mehr bringt sowieso nichts
#EVAL_DWARF = 0.00001 ;Alles was kleiner als dieser Wert ist wird wissenschaftlich notiert
#EVAL_GIANT = 1000000 ;Alles was grer-gleich ist wird wissenschaftlich notiert
Procedure.s MyEval(expr$) ; wird nur intern von Funktion Eval() aufgerufen
Protected exprLeft$, exprRight$, exprMid$, Result$, exprLen.l, valLeft.f, valRight.f, i.l, BracketCount.l
Protected start.l, intL, intR, vz$
EVAL_START:
exprLen = Len(expr$)
For i = 1 To exprLen ; In dieser Schleife schauen wir nach der ersten ffnenden Klammer
exprMid$ = Mid(expr$, i, 1)
If exprMid$ = "("
BracketCount = 1
start = i
For i = i+1 To exprLen ; wurde eine ffnende Klammer gefunden sucht diese Schleife die dazu passende schlieende
exprMid$ = Mid(expr$, i, 1)
If exprMid$ = "(" ;Sch... , noch eine Klammerebene
BracketCount + 1
ElseIf exprMid$ = ")"
BracketCount - 1
If BracketCount = 0 ; gefunden
exprLeft$ = Left(expr$, start-1)
exprRight$ = Right(expr$, exprLen - i)
exprMid$ = Mid(expr$, start+1, exprLen - Len(exprLeft$ + exprRight$) - 2)
exprMid$ = MyEval(exprMid$) ; berechnen des mittleren Abschnitts (der in der Klammer)
If exprMid$="x" : ProcedureReturn "x" : EndIf
expr$ = exprLeft$ + exprMid$ + exprRight$
Goto EVAL_START ;des Goto musste mal sein, ich brauch's ja sonst nie
EndIf
EndIf
Next
EndIf
Next
For i = exprLen To 1 Step -1
exprMid$ = Mid(expr$, i, 1)
Select exprMid$
Case "="
exprLeft$ = MyEval(Left(expr$, i-1))
exprRight$ = MyEval(Right(expr$, exprLen - i))
If exprLeft$="x" Or exprRight$="x" : ProcedureReturn "x" : EndIf
If exprLeft$ = exprRight$ : ProcedureReturn "1" : Else : ProcedureReturn "0.0" : EndIf
Case "<"
exprLeft$ = MyEval(Left(expr$, i-1))
exprRight$ = MyEval(Right(expr$, exprLen - i))
If exprLeft$="x" Or exprRight$="x" : ProcedureReturn "x" : EndIf
If ValF(exprLeft$) < ValF(exprRight$) : ProcedureReturn "1" : Else : ProcedureReturn "0.0" : EndIf
Case ">"
exprLeft$ = MyEval(Left(expr$, i-1))
exprRight$ = MyEval(Right(expr$, exprLen - i))
If exprLeft$="x" Or exprRight$="x" : ProcedureReturn "x" : EndIf
If ValF(exprLeft$) > ValF(exprRight$): ProcedureReturn "1" : Else : ProcedureReturn "0.0" : EndIf
EndSelect
Next
For i = exprLen To 1 Step -1
exprMid$ = Mid(expr$, i, 1)
Select exprMid$
Case "&"
exprLeft$ = MyEval(Left(expr$, i-1))
exprRight$ = MyEval(Right(expr$, exprLen - i))
If exprLeft$="x" Or exprRight$="x"
ProcedureReturn "x"
EndIf
intL.l = Val(exprLeft$)
intR.l = Val(exprRight$)
intR = intR & intL
Result$ = StrF(intR, #EVAL_GENAUGK)
ProcedureReturn Result$
Case "|"
exprLeft$ = MyEval(Left(expr$, i-1))
exprRight$ = MyEval(Right(expr$, exprLen - i))
If exprLeft$="x" Or exprRight$="x"
ProcedureReturn "x"
EndIf
intL.l = Val(exprLeft$)
intR.l = Val(exprRight$)
intR = intR | intL
Result$ = StrF(intR, #EVAL_GENAUGK)
ProcedureReturn Result$
EndSelect
Next
For i = exprLen To 1 Step -1 ; + und - Terme ausrechnen
exprMid$ = Mid(expr$, i, 1)
Select exprMid$
Case "+"
exprLeft$ = Left(expr$, i-1)
; statt Addition könnte es auch einfach nur ein Vorzeichen sein. Das wollen wir natürlich nicht berechnen.
If exprLeft$<>"" And FindString(#EVAL_NUMS ,Right(exprLeft$, 1), 1)
exprLeft$ = MyEval(exprLeft$)
exprRight$ = MyEval(Right(expr$, exprLen - i))
If exprLeft$="x" Or exprRight$="x"
ProcedureReturn "x"
EndIf
Result$ = StrF(ValF(exprLeft$) + ValF(exprRight$), #EVAL_GENAUGK)
ProcedureReturn Result$
EndIf
Case "-"
exprLeft$ = Left(expr$, i-1)
; ditto fr Subtraktion
If exprLeft$<>"" And FindString(#EVAL_NUMS ,Right(exprLeft$, 1), 1)
exprLeft$ = MyEval(exprLeft$)
exprRight$ = MyEval(Right(expr$, exprLen - i))
If exprLeft$="x" Or exprRight$="x" : ProcedureReturn "x" : EndIf
Result$ = StrF(ValF(exprLeft$) - ValF(exprRight$), #EVAL_GENAUGK)
ProcedureReturn Result$
EndIf
EndSelect
Next
For i = exprLen To 1 Step -1 ; Malnehmen, Teilen und Modulo (Restwertbildung)
exprMid$ = Mid(expr$, i, 1)
Select exprMid$
Case "*"
exprLeft$ = MyEval(Left(expr$, i-1))
exprRight$ = MyEval(Right(expr$, exprLen - i))
If exprLeft$="x" Or exprRight$="x"
ProcedureReturn "x"
EndIf
Result$ = StrF(ValF(exprLeft$) * ValF(exprRight$), #EVAL_GENAUGK)
ProcedureReturn Result$
Case "/"
exprLeft$ = MyEval(Left(expr$, i-1))
exprRight$ = MyEval(Right(expr$, exprLen - i))
If exprLeft$="x" Or exprRight$="x"
ProcedureReturn "x"
EndIf
Result$ = StrF(ValF(exprLeft$) / ValF(exprRight$), #EVAL_GENAUGK)
ProcedureReturn Result$
Case "%"
exprLeft$ = MyEval(Left(expr$, i-1))
exprRight$ = MyEval(Right(expr$, exprLen - i))
If exprLeft$="x" Or exprRight$="x"
ProcedureReturn "x"
EndIf
valLeft = ValF(exprLeft$)
valRight = ValF(exprRight$)
Result$ = StrF(valLeft-Int(valLeft/valRight)*valRight, #EVAL_GENAUGK)
ProcedureReturn Result$
EndSelect
Next
For i = exprLen To 1 Step -1 ; Potentes Ding
exprMid$ = Mid(expr$, i, 1)
If exprMid$ = "^"
exprLeft$ = MyEval(Left(expr$, i-1))
exprRight$ = MyEval(Right(expr$, exprLen - i))
If exprLeft$="x" Or exprRight$="x"
ProcedureReturn "x"
EndIf
valLeft = ValF(exprLeft$)
valRight = ValF(exprRight$)
Result$ = StrF(Pow(valLeft, valRight), #EVAL_GENAUGK)
ProcedureReturn Result$
EndIf
Next
exprLeft$ = Left(expr$, 1)
If exprLeft$ = "+" Or exprLeft$ = "-"
vz$ = exprLeft$
expr$ = Right(expr$, exprLen-1)
exprLen = Len(expr$)
Else
vz$ = ""
EndIf
;und nun bis zum Schluss noch einige nützliche Funktionen
exprLeft$ = Left(expr$, 4)
Select exprLeft$
Case "ASIN"
exprRight$ = Right(expr$, exprLen - 4)
valRight = ValF(exprRight$)
Result$ = StrF(ASin(valRight), #EVAL_GENAUGK)
ProcedureReturn vz$ + Result$
Case "ACOS"
exprRight$ = Right(expr$, exprLen - 4)
valRight = ValF(exprRight$)
Result$ = StrF(ACos(valRight), #EVAL_GENAUGK)
ProcedureReturn vz$ + Result$
Case "ATAN"
exprRight$ = Right(expr$, exprLen - 4)
valRight = ValF(exprRight$)
Result$ = StrF(ATan(valRight), #EVAL_GENAUGK)
ProcedureReturn vz$ + Result$
EndSelect
exprLeft$ = Left(expr$, 3)
Select exprLeft$
Case "SQR"
exprRight$ = Right(expr$, exprLen - 3)
valRight = ValF(exprRight$)
If valRight <0 : ProcedureReturn "x" : EndIf
Result$ = StrF(Sqr(valRight), #EVAL_GENAUGK)
ProcedureReturn vz$ + Result$
Case "LOG"
exprRight$ = Right(expr$, exprLen - 3)
valRight = ValF(exprRight$)
If valRight <0 : ProcedureReturn "x" : EndIf
Result$ = StrF(Log10(valRight), #EVAL_GENAUGK)
ProcedureReturn vz$ + Result$
Case "SIN"
exprRight$ = Right(expr$, exprLen - 3)
valRight = ValF(exprRight$)
Result$ = StrF(Sin(valRight), #EVAL_GENAUGK)
ProcedureReturn vz$ + Result$
Case "COS"
exprRight$ = Right(expr$, exprLen - 3)
valRight = ValF(exprRight$)
Result$ = StrF(Cos(valRight), #EVAL_GENAUGK)
ProcedureReturn vz$ + Result$
Case "TAN"
exprRight$ = Right(expr$, exprLen - 3)
valRight = ValF(exprRight$)
Result$ = StrF(Tan(valRight), #EVAL_GENAUGK)
ProcedureReturn vz$ + Result$
Case "ABS"
exprRight$ = Right(expr$, exprLen - 3)
valRight = ValF(exprRight$)
Result$ = StrF(Abs(valRight), #EVAL_GENAUGK)
ProcedureReturn vz$ + Result$
Case "INV"
exprRight$ = Right(expr$, exprLen - 3)
valRight = ValF(exprRight$)
If valRight =0 : ProcedureReturn "x" : EndIf
Result$ = StrF(1/valRight, #EVAL_GENAUGK)
ProcedureReturn vz$ + Result$
EndSelect
exprLeft$ = Left(expr$, 2)
Select exprLeft$
Case "LN"
exprRight$ = Right(expr$, exprLen - 2)
valRight = ValF(exprRight$)
If valRight <0 : ProcedureReturn "x" : EndIf
Result$ = StrF(Log(valRight), #EVAL_GENAUGK)
ProcedureReturn vz$ + Result$
EndSelect
exprLeft$ = Left(expr$, 1)
Select exprLeft$
Case "!"
exprRight$ = Right(expr$, exprLen - 1)
valRight = ValF(exprRight$)
If Int(valRight)>=0
valLeft = 1
For i = 2 To Int(valRight) : valLeft * i : Next
Else : ProcedureReturn "x" : EndIf
Result$ = StrF(valLeft, #EVAL_GENAUGK)
ProcedureReturn vz$ + Result$
EndSelect
ProcedureReturn vz$ + StrF(ValF(expr$), #EVAL_GENAUGK)
EndProcedure
Procedure.s Calc(expr$) ;Pre- und Postprocessor, eigentliches Rechnen in MyEval()
Global Eval_LastResult$
Protected prependix$,posE, posMant, posExp, prt1$, prt2$, prt3$, prt4$, exprLen,vz$, exp
expr$ = UCase(expr$) ; Alles Grossbuchstaben, so haben wir's beim Parsen einfacher
expr$ = ReplaceString(expr$, " ", "") ; Leerzeichen entfernen
expr$ = ReplaceString(expr$, "PI", "3.1415926535897932384626433832795") ; Kreiskonstante PI
expr$ = ReplaceString(expr$, "EUL", "2.7182818284590452353602874713527") ; Eulersche Zahl
expr$ = ReplaceString(expr$, "LR", Eval_LastResult$) ; Das letzte Ergebnis
expr$ = ReplaceString(expr$, ",", ".") ; Dezimalpunkt statt Komma
expr$ = ReplaceString(expr$, ":", "/") ; Beide Notationen für Division zulassen
expr$ = ReplaceString(expr$, "x", "*") ; Beide Notationen für Multiplikation zulassen
; Wissenschaftliche Zahlennotation zulassen
Repeat
posE = FindString(expr$, "E", 1)
If posE > 0 And FindString("+-", Mid(expr$, posE+1, 1), 1)
posMant = posE - 1
While posMant>0 And FindString(#EVAL_NUMS+".", Mid(expr$, posMant, 1), 1)
posMant - 1
Wend
posExp = posE + 2
While posExp <= Len(expr$) And FindString(#EVAL_NUMS+".", Mid(expr$, posExp, 1), 1)
posExp + 1
Wend
prt1$ = Left(expr$, posMant)
prt2$ = Mid(expr$,posMant+1, posE - posMant -1)
prt3$ = Mid(expr$, posE + 1, posExp - posE -1)
prt4$ = Right(expr$, Len(expr$)-posExp+1)
expr$ = prt1$ + "(" + prt2$ + "e" + prt3$ + ")" + prt4$
EndIf
Until posE = 0
expr$ = ReplaceString(expr$, "e+", "*10^")
expr$ = ReplaceString(expr$, "e-", "*10^-")
;Protected a$="Calc: "+Chr(34)+expr$+Chr(34)+" = "
expr$ = MyEval(expr$) ; Jetzt lassen wir richtig rechnen
;Debug a$+Chr(34)+expr$+Chr(34)
If expr$ = "x"
expr$ = "ERROR"
Else
Eval_LastResult$ = expr$ ; und speichern das Ergebniss zur spteren Verwendung
; überschüssige Nullen (und evtl. auch Dezimalpunkt) am Ende entfernen
exprLen = Len(expr$)
While Mid(expr$, exprLen, 1) = "0" : exprLen - 1: Wend
expr$ = Left(expr$, exprLen)
If Right(expr$, 1) = "." : expr$ = Left(expr$, exprLen-1) : EndIf
If expr$ = "" : expr$ = "0": EndIf
; Bei kleinen und großen Zahlen die Wissenschaftliche Notation verwenden
If expr$ <> "0" And Abs(ValF(expr$)) < #EVAL_DWARF
; If Abs(ValF(expr)) < #EVAL_DWARF And expr <> "0" ; auch hier ein Bug durch leicht anderen Aufruf !!!!!!!!!!!!!!
exprLen = Len(expr$)
If Left(expr$, 1) = "-"
vz$ = "-"
expr$ = Right(expr$, exprLen - 3)
Else
vz$ = ""
expr$ = Right(expr$, exprLen - 2)
EndIf
exp = 1
While Left(expr$, 1) = "0"
expr$ = Right(expr$, Len(expr$)-1)
exp + 1
Wend
expr$ = vz$ + Left(expr$, 1) + "." + Right(expr$, Len(expr$)-1) + "E-" + Str(exp)
EndIf
If Abs(ValF(expr$)) >= #EVAL_GIANT
exprLen = Len(expr$)
If Left(expr$, 1) = "-"
vz$ = "-"
expr$ = Right(expr$, exprLen - 1)
Else
vz$ = ""
EndIf
expr$ = vz$ + Left(expr$, 1) + "." + Right(expr$, Len(expr$)-1) + "E+" + Str(Len(expr$)-1)
EndIf
expr$ = prependix$ + expr$
prependix$ = ""
EndIf
ProcedureReturn expr$
EndProcedure
Formel$= "(12 * Sin(2 * x) + 2) / Sqr(x ^ 2 + 1)"
Result$=Calc(Formel$)
Debug Formel$ + " = "+Result$
