
Ein einfaches Beispiel:
Code: Alles auswählen
Debug Calculate("67*6/1+(5^2)")
Beispielsweise:
Code: Alles auswählen
Debug Calculate("Sin(90/180*#Pi)")
Debug Calculate("5 * Round ( 5.49 )")
Debug Calculate("Abs(-1) * Int(4.8)")
Debug Calculate("Degree(Radian(10))")
Sollte es Strings geben, die falsch ausgerechnet werden, bitte melden! Hoffe ich kann spezielle "Unfälle" dann fixen.

Code: Alles auswählen
; ******************************
;
; CalculateIt
;
; ******************************
;
; (c) Daniel Obermeier 2007-2010
;
; ******************************
; Besonderheiten:
; "-7^2" = 49 (Hier wird das Minus in die Berechnung einbezogen, als Ersatz, da eine mathematische Klammer nicht direkt beachtet wird)
; "(-7)^2" = 49 (Hier wird die Klammer automatisch zuerst aufgelöst, wodurch die obere Gleichung entsteht)
; "-(7^2)" = - 49
; Fakultät und NOT wird benutzt wie eine Funktion:
; "Fact(...)"
; "Not(...)"
; Ab Fact(22) aufwärts werden die Ergebnisse der Fakultät durch die Doubles ungenau
; Vorgegebene Konstanten:
; #Pi
; #e
; Verwendbare Funktionen:
; - Abs()
; - ACos()
; - ACosH()
; - ASin()
; - ASinH()
; - ATan()
; - ATanH()
; - Blue()
; - Cos()
; - CosH()
; - Degree()
; - Fact() [Fakultät]
; - Green()
; - Log()
; - Log10()
; - Not() [Logisches NOT]
; - Radian()
; - Red()
; - Round()
; - Int()
; - Sign()
; - Sin()
; - SinH()
; - Sqr()
; - Tan()
; - TanH()
EnableExplicit
Procedure.i IsNumber(String.s)
Protected CurrentPosition.i = 0
Protected CheckCharacter.s = ""
If Len(String) = 0
ProcedureReturn 0
EndIf
For CurrentPosition = 1 To Len(String)
CheckCharacter.s = Mid(String, CurrentPosition, 1)
If Len(String) > 1 And CurrentPosition = 1 And (CheckCharacter = "-" Or CheckCharacter = "+")
; Was ist alles zulässig...
ElseIf CheckCharacter = "."
; Was ist alles zulässig...
ElseIf Str(Val(CheckCharacter)) = CheckCharacter
; Was ist alles zulässig...
Else
ProcedureReturn 0
EndIf
Next
ProcedureReturn 1
EndProcedure
Procedure.s TrimZeros(String.s)
Protected LastZero.i
If FindString(String, ".", 1)
For LastZero = Len(String) To 1 Step -1
If Mid(String, LastZero, 1) <> "0"
Break
EndIf
Next
If Mid(String, LastZero, 1) = "."
ProcedureReturn Left(String, LastZero - 1)
Else
ProcedureReturn Left(String, LastZero)
EndIf
Else
ProcedureReturn String
EndIf
EndProcedure
Macro StrDD(Value)
TrimZeros(StrD(Value, 16))
EndMacro
Macro RoundNearest(Content)
Round(Content, #PB_Round_Nearest)
EndMacro
Procedure.q NotFunction(Value.d)
ProcedureReturn ~IntQ(Value)
EndProcedure
Procedure.d FactorialFunction(Value.i)
Protected Index.i
Protected Result.d = 1
For Index = 1 To IntQ(Value)
Result * Index
Next
ProcedureReturn Result
EndProcedure
Macro Function(CalculateName, Length, PurebasicName)
; Length könnte man durch Len(CalculateName) ersetzen, aber aus Performancegründen geben wir die Stringlänge dann beim Aufruf von Function() an
; Wenn PB schlau wäre, könnte er das ja direkt beim kompilieren ersetzen, aber ich vermute Len("123") wird nicht durch "3" ersetzt, sondern wird ins Executable übernommen...
ElseIf Mid(String, BracketFirst - Length, Length) = CalculateName
LengthLeft - Length
If IsNumber(Mid(String, BracketFirst - 1 - Length, 1))
String = Left(String, LengthLeft) + "*" + StrDD(PurebasicName(ValD(StringInBrackets))) + Right(String, LengthRight)
Else
String = Left(String, LengthLeft) + StrDD(PurebasicName(ValD(StringInBrackets))) + Right(String, LengthRight)
EndIf
EndMacro
Procedure.s RemoveNeedlessBrackets(String.s)
Protected BracketFirst.i = 0
Protected BracketLast.i = 0
Protected LengthLeft.i = 0
Protected LengthRight.i = 0
Protected CurrentPosition.i = 0
Protected StringInBrackets.s = ""
BracketFirst = 0
BracketLast = 0
CurrentPosition = 0
Repeat
CurrentPosition + 1
If Mid(String, CurrentPosition, 1) = "("
BracketFirst = CurrentPosition
EndIf
If Mid(String, CurrentPosition, 1) = ")"
BracketLast = CurrentPosition
EndIf
If BracketFirst And BracketLast
StringInBrackets.s = Mid(String, BracketFirst + 1, BracketLast - BracketFirst - 1)
If IsNumber(StringInBrackets) ; (zahl) oder f(zahl) -> Dann können wir die Klammern drumherum weghauen / die Funktion auflösen
LengthLeft = BracketFirst - 1
LengthRight = Len(String) - BracketLast
If 0 ; In Function steckt das ElseIf, so muss das erste ElseIf unbedingt durch Fehlschlag ausgeführt werden...
Function("SQR", 3, Sqr)
Function("NOT", 3, NotFunction)
Function("FACT", 4, FactorialFunction)
Function("ASIN", 4, ASin)
Function("ASINH", 5, ASinH)
Function("ACOS", 4, Acos)
Function("ACOSH", 5, AcosH)
Function("ATAN", 4, Atan)
Function("ATANH", 5, AtanH)
Function("SIN", 3, Sin)
Function("SINH", 4, SinH)
Function("COS", 3, Cos)
Function("COSH", 4, CosH)
Function("DEGREE", 6, Degree)
Function("TAN", 3, Tan)
Function("TANH", 4, TanH)
Function("LOG", 3, Log)
Function("LOG10", 5, Log10)
Function("RADIAN", 6, Radian)
Function("ROUND", 5, RoundNearest)
Function("ABS", 3, Abs)
Function("INT", 3, Int)
Function("SIGN", 4, Sign)
Function("RED", 3, Red)
Function("GREEN", 5, Green)
Function("BLUE", 4, Blue)
Else
If IsNumber(Mid(String, BracketFirst - 1, 1))
String = Left(String, LengthLeft) + "*" + StringInBrackets + Right(String, LengthRight)
Else
String = Left(String, LengthLeft) + StringInBrackets + Right(String, LengthRight)
EndIf
EndIf
CurrentPosition = 1
EndIf
BracketFirst = 0
BracketLast = 0
EndIf
Until CurrentPosition = Len(String)
ProcedureReturn String
EndProcedure
Procedure.s ChangeDoublePrefix(String.s)
While CountString(String, "--") Or CountString(String, "++") Or CountString(String, "+-") Or CountString(String, "-+")
String = ReplaceString(String, "--", "+")
String = ReplaceString(String, "++", "+")
String = ReplaceString(String, "+-", "-")
String = ReplaceString(String, "-+", "-")
Wend
ProcedureReturn String
EndProcedure
Macro GetStringInBrackets()
BracketFirst = 0
BracketLast = 0
For CurrentPosition = 1 To Len(Input)
If Mid(Input, CurrentPosition, 1) = "("
BracketFirst = CurrentPosition
EndIf
If Mid(Input, CurrentPosition, 1) = ")"
BracketLast = CurrentPosition
EndIf
If BracketFirst And BracketLast
StringInBrackets = Mid(Input, BracketFirst + 1, BracketLast - BracketFirst - 1)
Break
EndIf
Next
EndMacro
Macro Calculation(CalculateOperator, PurebasicOperator, ValType, ResultType, IsDivision, IsPower)
LeftParameter = ""
RightParameter = ""
If Mid(StringInBrackets, CurrentPosition, 1) = CalculateOperator
For SearchParameterIndex = CurrentPosition - 1 To 1 Step -1
If IsNumber(Mid(StringInBrackets, SearchParameterIndex, 1)) = 0
LeftParameter.s = Mid(StringInBrackets, SearchParameterIndex + 1, CurrentPosition - SearchParameterIndex - 1)
LengthLeft = BracketFirst + SearchParameterIndex
If Mid(StringInBrackets, SearchParameterIndex, 1) = "-"
LeftParameter = "-" + LeftParameter
LengthLeft - 1
EndIf
Break
ElseIf SearchParameterIndex = 1
LeftParameter.s = Mid(StringInBrackets, SearchParameterIndex, CurrentPosition - SearchParameterIndex)
LengthLeft = BracketFirst
Break
EndIf
Next
For SearchParameterIndex = CurrentPosition + 1 To Len(StringInBrackets) Step 1
If IsNumber(Mid(StringInBrackets, SearchParameterIndex + 1, 1)) = 0 And Mid(StringInBrackets, CurrentPosition + 1, 1) = "-"
RightParameter.s = Mid(StringInBrackets, CurrentPosition + 1, SearchParameterIndex - CurrentPosition)
LengthRight = Len(Input) - (BracketFirst + SearchParameterIndex)
Break
ElseIf IsNumber(Mid(StringInBrackets, SearchParameterIndex, 1)) = 0 And Mid(StringInBrackets, CurrentPosition + 1, 1) <> "-"
RightParameter.s = Mid(StringInBrackets, CurrentPosition + 1, SearchParameterIndex - CurrentPosition - 1)
LengthRight = Len(Input) - (BracketFirst + SearchParameterIndex - 1)
Break
ElseIf SearchParameterIndex = Len(StringInBrackets)
RightParameter.s = Mid(StringInBrackets, CurrentPosition + 1, SearchParameterIndex - CurrentPosition)
LengthRight = Len(Input) - (BracketLast) + 1
Break
EndIf
Next
If IsNumber(LeftParameter) And IsNumber(RightParameter)
CompilerIf IsDivision
If ValType(RightParameter)
ResultType = ValD(LeftParameter) PurebasicOperator ValD(RightParameter)
Input = Left(Input, LengthLeft) + StrDD(ResultType) + Right(Input, LengthRight)
GetStringInBrackets()
CurrentPosition = 1
Else
ProcedureReturn 0 ; Teilen durch 0
EndIf
CompilerElse
CompilerIf IsPower
ResultType = Pow(ValType(LeftParameter), ValType(RightParameter))
CompilerElse
ResultType = ValType(LeftParameter) PurebasicOperator ValType(RightParameter)
CompilerEndIf
Input = Left(Input, LengthLeft) + StrDD(ResultType) + Right(Input, LengthRight)
GetStringInBrackets()
CurrentPosition = 1
CompilerEndIf
EndIf
EndIf
EndMacro
ProcedureDLL.d Calculate(Input.s)
Protected ResultFloat.d = 0
Protected ResultInt.q = 0
Protected CurrentPosition.i = 0
Protected SearchParameterIndex.i = 0
Protected StringInBrackets.s = ""
Protected LeftParameter.s = ""
Protected RightParameter.s = ""
Protected LengthLeft.i = 0
Protected LengthRight.i = 0
Protected BracketFirst.i = 0
Protected BracketLast.i = 0
Protected FirstInput.s = ""
If CountString(Input, "(") <> CountString(Input, ")")
ProcedureReturn 0
EndIf
Input = "(" + UCase(RemoveString(Input, " ")) + ")"
Input = ReplaceString(Input, "#PI", StrDD(#PI))
Input = ReplaceString(Input, "#E", StrDD(#E))
Input = ChangeDoublePrefix(Input)
Input = RemoveNeedlessBrackets(Input)
Repeat
; Den ersten innersten Klammerstring finden:
FirstInput = Input
GetStringInBrackets()
; Wir suchen jetzt nach möglichen Berechnungen im innersten Klammerstring, der Priorität nach
For CurrentPosition = 1 To Len(StringInBrackets) ; Prüfen auf Priorität 1: > < % !
Calculation(">", >>, Val, ResultInt, #False, #False)
Calculation("<", <<, Val, ResultInt, #False, #False)
Calculation("%", %, Val, ResultInt, #False, #False)
Calculation("!", !, Val, ResultInt, #False, #False)
Next
For CurrentPosition = 1 To Len(StringInBrackets) ; Prüfen auf Priorität 2: | &
Calculation("|", |, Val, ResultInt, #False, #False)
Calculation("&", &, Val, ResultInt, #False, #False)
Next
For CurrentPosition = 1 To Len(StringInBrackets) ; Prüfen auf Priorität 3: ^
Calculation("^", ^, ValD, ResultFloat, #False, #True)
Next
For CurrentPosition = 1 To Len(StringInBrackets) ; Prüfen auf Priorität 4: / *
Calculation("/", /, ValD, ResultFloat, #True, #False)
Calculation("*", *, ValD, ResultFloat, #False, #False)
Next
For CurrentPosition = 1 To Len(StringInBrackets) ; Prüfen auf Priorität 5: + -
Calculation("+", +, ValD, ResultFloat, #False, #False)
Calculation("-", -, ValD, ResultFloat, #False, #False)
Next
; Der bearbeitete StringInBrackets sollte jetzt auf eine Zahl aufgelöst sein
Input = ChangeDoublePrefix(Input)
Input = RemoveNeedlessBrackets(Input)
If CountString(Input, "(") = 0 And CountString(Input, ")") = 0
Break
EndIf
If Input = FirstInput
ProcedureReturn 0
EndIf
ForEver
ProcedureReturn ValD(Input)
EndProcedure