mais cette fonction est dans une dll
le resultat retourne est absolument pas valable
comment faire :
Code : Tout sélectionner
#x_center = 400
#y_center = 300
OpenWindow(0, 0, 0, #x_center * 2, #x_center * 2, "Courbes 3D", #PB_Window_ScreenCentered | #PB_Window_MinimizeGadget)
If InitSprite() = 0 Or InitMouse() = 0 Or InitKeyboard() = 0 : End : EndIf
OpenWindowedScreen(WindowID(0), 0, 0, #x_center * 2, #x_center * 2, 0, 0, 0)
KeyboardMode(1)
Global equation$, x_min.l, x_max.l, y_min.l, y_max.l, Dimentionp.l, zoom.l, zoom_z.f, max.f, min.f, event
Prototype.s result(expression.s, x.f, y.f, etat.l)
x_min = -20
x_max = 20
y_min = -20
y_max = 20
Dimentionp = (x_max - x_min + 1) * (y_max - y_min + 1) + 3
zoom = 5
zoom_z = 0.05
vit = 5
Global Dim Cotes.f(Dimentionp)
Global Dim Abscisse.f(Dimentionp)
Global Dim Ordonne.f(Dimentionp)
Global Dim Cotes_.f(Dimentionp)
Global Dim Abscisse_.f(Dimentionp)
Global Dim Ordonne_.f(Dimentionp)
Global Dim Couleur_(Dimentionp)
If OpenLibrary(0, "Expression_valeurs_litterale.dll") = 0 : End : EndIf
Global Fonction_.result = GetFunction(0, "EvaluateVariable")
Procedure ls_GetColorPalette(abscisse.f, Ordonne.f, max.f, maxY.f); retourne la couleur d'une palette aux coordonnée specifie
Protected couleur, taux.f, index1.f, index2.f, index3.f, index4.f, index5.f
index1.f = max / 6
index2.f = 2 * max / 6
index3.f = 3 * max / 6
index4.f = 4 * max / 6
index5.f = 5 * max / 6
If Ordonne * 2 / maxY > 1
abscisse - index1
If abscisse < 0 : abscisse + max : EndIf
EndIf
If abscisse >= 0 And abscisse <= index1
couleur = RGB(255, (((abscisse * max) / index1) * 255) / max, 0)
EndIf
If abscisse > index1 And abscisse <= index2
couleur = RGB(((max - ((abscisse - index1) * max) / index1) * 255) / max, 255, 0)
EndIf
If abscisse > index2 And abscisse <= index3
couleur = RGB(0, 255, ((((abscisse - index2) * max) / index1) * 255) / max)
EndIf
If abscisse > index3 And abscisse <= index4
couleur = RGB(0, ((max - ((abscisse - index3) * max) / index1) * 255) / max, 255)
EndIf
If abscisse > index4 And abscisse <= index5
couleur = RGB(((abscisse - index4) * 255) / index1, 0, 255)
EndIf
If abscisse > index5 And abscisse <= max
couleur = RGB(255, 0, ((max - ((abscisse - index5) * max) / index1) * 255) / max)
EndIf
taux.f = Ordonne * 2 / maxY
If taux <= 1
couleur = RGB(taux * Red(couleur), taux * Green(couleur), taux * Blue(couleur))
Else
taux - 2
couleur = RGB(255 + taux * Green(couleur), 255 + taux * Blue(couleur), 255 + taux * Red(couleur))
EndIf
ProcedureReturn couleur
EndProcedure
Procedure DuplicateBoardF(*board.Float, *board2.Float, Dimx, Dimy); duplique le tableau d'adresse *board dans le tableau d'adresse *board2
*mem.Float = *board.Float
*board + 4 * (Dimx + 1) * (Dimy + 1)
CopyMemory(*mem, *board2, *board - *mem)
EndProcedure
Procedure.f Fract1(num.f)
ProcedureReturn num - Int(num)
EndProcedure
Procedure.f Convert1(degre.f, radian.f) ; Convertti un nombre en degré en radian ou si degre = 0, le contraire
If degre = 0
ProcedureReturn ((180 * radian) / #PI)
EndIf
ProcedureReturn ((#PI * degre) / 180)
EndProcedure
Procedure.f Fonction(expression.s, x.f, y.f)
ProcedureReturn ValF(fonction_(expression, x, y, 1))
EndProcedure
Procedure ActualiseCourbe()
c = 0
For a = x_min To x_max
For b = y_min To y_max
Cotes(c) = Fonction(equation$, a, b) * zoom * zoom_z
c + 1
Next
Next
c = 0
For a = x_min To x_max
For b = y_min To y_max
Abscisse(c) = a * zoom
c + 1
Next
Next
c = 0
For a = x_min To x_max
For b = y_min To y_max
Ordonne(c) = b * zoom
c + 1
Next
Next
min = Cotes(0)
max = Cotes(0)
For c = 1 To Dimentionp - 2
If Cotes(c) < min : min = Cotes(c) : EndIf
If Cotes(c) > max : max = Cotes(c) : EndIf
Next
For c = 0 To Dimentionp - 2
Couleur_(c) = 255 * (Cotes(c) - min) / (max - min)
Next
Cotes(Dimentionp - 2) = 0
Cotes(Dimentionp - 1) = 0
Cotes(Dimentionp) = (x_max + y_max) / 2 * zoom
Abscisse(Dimentionp - 2) = x_max * zoom
Abscisse(Dimentionp - 1) = 0
Abscisse(Dimentionp) = 0
Ordonne(Dimentionp - 2) = 0
Ordonne(Dimentionp - 1) = y_max * zoom
Ordonne(Dimentionp) = 0
DuplicateBoardF(@Cotes(), @Cotes_(), Dimentionp, 0)
DuplicateBoardF(@Abscisse(), @Abscisse_(), Dimentionp, 0)
DuplicateBoardF(@Ordonne(), @Ordonne_(), Dimentionp, 0)
EndProcedure
Procedure Menu()
DisableWindow(0, 1)
If OpenWindow(1, 0, 0, 120, 160, "Menu", #PB_Window_WindowCentered, WindowID(0))
If CreateGadgetList(WindowID(1))
ButtonGadget(0, 10, 10, 100, 20, "Equation")
ButtonGadget(1, 10, 40, 100, 20, "Ouvrir")
ButtonGadget(2, 10, 70, 100, 20, "Sauver")
ButtonGadget(3, 10, 100, 100, 20, "Annuler")
ButtonGadget(4, 10, 130, 100, 20, "Quitter")
EndIf
Repeat
event1 = WaitWindowEvent()
If event1 = #PB_Event_Gadget
Select EventGadget()
Case 0
equation$ = InputRequester("Equation = ", "Entrez l'équation a deux variables:", equation$)
ActualiseCourbe()
event1 = #PB_Event_CloseWindow
Case 1
Case 2
Case 3
event1 = #PB_Event_CloseWindow
Case 4
event1 = #PB_Event_CloseWindow
event = #PB_Event_CloseWindow
EndSelect
EndIf
Until event1 = #PB_Event_CloseWindow
CloseWindow(1)
EndIf
DisableWindow(0, 0)
EndProcedure
Procedure Display_3D(rotX.f, rotY.f, rotZ.f, oui)
If oui = 1
DuplicateBoardF(@Cotes_(), @Cotes(), Dimentionp, 0)
DuplicateBoardF(@Abscisse_(), @Abscisse(), Dimentionp, 0)
DuplicateBoardF(@Ordonne_(), @Ordonne(), Dimentionp, 0)
rotx = Convert1(rotx, 0)
roty = Convert1(roty, 0)
rotz = Convert1(rotz, 0)
Dim angle.f(Dimentionp)
;{ rotation autour de z
If rotz
For curs = 0 To Dimentionp
If Abscisse(curs) = 0 : Abscisse(curs) = 0.0000001 : EndIf
If Abscisse(curs) <> 0
angle(curs) = rotz + ATan(Ordonne(curs) / Abscisse(curs))
If Abscisse(curs) <= 0
angle(curs) = #PI + angle(curs)
EndIf
ElseIf Ordonne(curs) > 0
angle(curs) = #PI / 2 + rotz
ElseIf Ordonne(curs) <= 0
angle(curs) = #PI + rotz
EndIf
distance.f = Sqr(Abscisse(curs) * Abscisse(curs) + Ordonne(curs) * Ordonne(curs))
Abscisse(curs) = distance * Cos(angle(curs))
Ordonne(curs) = distance * Sin(angle(curs))
Next
EndIf
;}
Dim angle.f(Dimentionp)
;{ rotation autour de y
If roty
For curs = 0 To Dimentionp
If Abscisse(curs) = 0 : Abscisse(curs) = 0.0000001 : EndIf
If Abscisse(curs) <> 0
angle(curs) = roty + ATan(Cotes(curs) / Abscisse(curs))
If Abscisse(curs) <= 0
angle(curs) = #PI + angle(curs)
EndIf
ElseIf Cotes(curs) > 0
angle(curs) = #PI / 2 + roty
ElseIf Cotes(curs) <= 0
angle(curs) = #PI - roty
EndIf
distance.f = Sqr(Abscisse(curs) * Abscisse(curs) + Cotes(curs) * Cotes(curs))
Abscisse(curs) = distance * Cos(angle(curs))
Cotes(curs) = distance * Sin(angle(curs))
Next
EndIf
;}
Dim angle.f(Dimentionp)
;{ rotation autour de x
If rotx
For curs = 0 To Dimentionp
If Cotes(curs) = 0 : Cotes(curs) = 0.0000001 : EndIf
If Cotes(curs) <> 0
angle(curs) = rotx + ATan(Ordonne(curs) / Cotes(curs))
If Cotes(curs) <= 0
angle(curs) = #PI + angle(curs)
EndIf
ElseIf Ordonne(curs) > 0
angle(curs) = #PI / 2 + rotx
ElseIf Ordonne(curs) <= 0
angle(curs) = #PI + rotx
EndIf
distance.f = Sqr(Cotes(curs) * Cotes(curs) + Ordonne(curs) * Ordonne(curs))
Cotes(curs) = distance * Cos(angle(curs))
Ordonne(curs) = distance * Sin(angle(curs))
Next
EndIf
;}
EndIf
;{ affichage des lignes
For c = 0 To Dimentionp - (y_max - y_min + 1) - 1 - 3
moy = (Couleur_(c) + Couleur_(c + (y_max - y_min + 1))) / 2
color = ls_GetColorPalette(moy, 125, 255, 255)
LineXY(Abscisse(c) + #x_center, Ordonne(c) + #y_center, Abscisse(c + (y_max - y_min + 1)) + #x_center, Ordonne(c + (y_max - y_min + 1)) + #y_center, color)
Next
For c = 0 To Dimentionp - 2 - 3
If Fract1((c + 1) / (y_max - y_min + 1)) <> 0
moy = (Couleur_(c) + Couleur_(c + 1)) / 2
color = ls_GetColorPalette(moy, 125, 255, 255)
LineXY(Abscisse(c) + #x_center, Ordonne(c) + #y_center, Abscisse(c + 1) + #x_center, Ordonne(c + 1) + #y_center, color)
EndIf
Next
For c = Dimentionp - 2 To Dimentionp
LineXY(Abscisse(c) + #x_center, Ordonne(c) + #y_center, #x_center, #y_center, RGB(255, 0, 0))
If c = Dimentionp - 2
DrawText(Abscisse(c) + #x_center + 10, Ordonne(c) + #y_center + 10, "X", RGB(255, 0, 0))
EndIf
If c = Dimentionp - 1
DrawText(Abscisse(c) + #x_center + 10, Ordonne(c) + #y_center + 10, "Y", RGB(255, 0, 0))
EndIf
If c = Dimentionp
DrawText(Abscisse(c) + #x_center + 10, Ordonne(c) + #y_center + 10, "Z", RGB(255, 0, 0))
EndIf
Next
;}
EndProcedure
rotx = 0
roty = 0
rotz = 0
Repeat
event = WindowEvent()
ExamineKeyboard()
If KeyboardPushed(#PB_Key_Escape)
Menu()
EndIf
old_x = rotx
old_y = roty
old_z = rotz
If KeyboardPushed(#PB_Key_Up) : rotx - vit : EndIf
If KeyboardPushed(#PB_Key_Down) : rotx + vit : EndIf
If KeyboardPushed(#PB_Key_Left) : roty + vit : EndIf
If KeyboardPushed(#PB_Key_Right) : roty - vit : EndIf
If KeyboardPushed(#PB_Key_A) : rotz - vit : EndIf
If KeyboardPushed(#PB_Key_Z) : rotz + vit : EndIf
Delay(1)
; ClearScreen(RGB(255, 255, 255))
ClearScreen(0)
If equation$ <> ""
If StartDrawing(ScreenOutput())
DrawText(0, 0, "Fonction = " + equation$)
If old_x <> rotx Or old_y <> roty Or old_z <> rotz
Display_3D( rotx, roty, rotz, 1)
Else
Display_3D( rotx, roty, rotz, 0)
EndIf
StopDrawing()
EndIf
EndIf
FlipBuffers()
Until event = #PB_Event_CloseWindow
CloseLibrary(0)
End
avec PB 3.94 !!
Code : Tout sélectionner
#erreur = -1000000000
Global X.f, Y.f
Procedure.s ReplaceSigne(expression.s)
Debug "---- ReplaceString"
While FindString(expression, "--", 0) Or FindString(expression, "++", 0) Or FindString(expression, "-+", 0) Or FindString(expression, "+-", 0)
Debug "---- remplacement"
expression = ReplaceString(expression, "--", "+")
expression = ReplaceString(expression, "++", "+")
expression = ReplaceString(expression, "+-", "-")
expression = ReplaceString(expression, "-+", "-")
Debug "---- " + expression
Wend
ProcedureReturn expression
EndProcedure
Procedure.s xs_Valid_test(st1.s) ; retourne si la chaine est valable ou non
Protected e1, c1, st1.s, st.s, equilibre, p1, etat, result.s, car.s, n1
#etats = 5
#caracs = 16 + 26 ; 16 + 26 caractères autorisés pour la saisie
Dim tab(5, 16 + 26)
Restore caractere
For e1 = 1 To 5
For c1=1 To 16 + 26
Read tab(e1,c1)
Next c1
Next e1
If st1=""
ProcedureReturn "Chaîne vide"
EndIf
st.s = "0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ+-*/()" ; les 16 + 26 caractères possibles
equilibre = 0 ; comptage des parenthèses
p1 = 0 ; position courante dans la chaîne s
etat = 1 ; Etat initial
result.s = "" ; Resultat du test de l'expression
For carac = 1 To Len(st1)
If Mid(st1, carac, 1) = "." And Asc(Mid(st1, carac + 1, 1)) >= 48 And Asc(Mid(st1, carac + 1, 1)) <= 57
st1 = Left(st1, carac - 1) + Mid(st1, carac + 1, Len(st1))
EndIf
Next
Repeat
p1+1
car.s = Mid(st1,p1,1) ; caractère en cours
If car = "(" : equilibre+1 : EndIf
If car = ")" : equilibre-1 : EndIf
If equilibre >= 0
; position du caractère en cours dans la chaîne de caractères autorisés
n1 = FindString(st,car,1)
If n1>0 : etat = tab(etat,n1) : EndIf ; c'est un caractère autorisé
EndIf
Until (p1 = Len(st1)) Or (equilibre < 0) Or (n1 = 0) Or (etat = 0)
If equilibre<0
result="Il y a une parenthèse fermante en trop à la position " + Str(p1)
ElseIf equilibre>0
result="Il y a une parenthèse ouvrante en trop"
ElseIf n1=0
result="Caractère non autorisé à la position " + Str(p1)
ElseIf etat=0
result="Expression incorrecte (erreur à la position " + Str(p1) + ")"
ElseIf etat<>3 And etat<>4
result="Expression incorrecte (etat final non terminal)"
Else
result="Expression correcte"
EndIf
ProcedureReturn result
DataSection
; 0 1 2 3 4 5 6 7 8 9 + - * / ( )
caractere:
Data.l 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 2, 2, 0, 0, 1, 0 ; {etat 1}
Data.l 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 0, 0, 0, 0, 1, 0 ; {etat 2}
Data.l 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 5, 5, 5, 5, 0, 4 ; {etat 3}
Data.l 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 5, 5, 5, 5, 0, 4 ; {etat 4}
Data.l 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 0, 0, 0, 0, 1, 0 ; {etat 5}
EndDataSection
EndProcedure
Procedure.s xs_SolveFunction_test(Named.s, Parameters.s, Count.l)
; Solve a function.
Protected Result.s, Named.s, parametres.s, Count.l
Named = LCase(Named)
If Named = "round"
If Count <> 2 : ProcedureReturn "ERR-Round Function Requires 2 Numeric Parameters" : EndIf
Result = StrF(ValF(StringField(Parameters, 1, ",")), Val(StringField(Parameters, 2, ",")))
ProcedureReturn Result
ElseIf named = "int"
If Count <> 1 : ProcedureReturn "ERR-Int Function Requires 1 Numeric Parameter" : EndIf
result = Str(Int(ValF(StringField(Parameters, 1, ","))))
ProcedureReturn result
ElseIf named = "abs"
If Count <> 1 : ProcedureReturn "ERR-Abs Function Requires 1 Numeric Parameter" : EndIf
result = StrF(Abs(ValF(StringField(Parameters, 1, ","))))
ProcedureReturn result
ElseIf named = "frac"
If Count <> 1 : ProcedureReturn "ERR-Frac Function Requires 1 Numeric Parameter" : EndIf
result = StrF(Fract(ValF(StringField(Parameters, 1, ","))))
ProcedureReturn result
Else
ProcedureReturn "ERR-Unsupported Function"
EndIf
EndProcedure
Procedure.s xs_Evaluate_test(Expression.s) ; retourne la valeur de l'expression literale
Protected iLoop.l, *Position.l, HoldChar.b, HoldExpression.s, HoldParameters.s, Opened.l, Closed.l, FunctionBegin.l, FunctionEnd.l
Protected FunctionNamed.s, LastIsOpen.b, CountParanthesis.l, CountParameters.l, Length.l, Result.s
;{ Create Variables
iLoop.l
;
*Position.l
;
HoldChar.b
;
HoldExpression.s
;
HoldParameters.s
;
Opened.l
; Location of the current open paranthesis.
Closed.l
; Location of the current closed paranthesis.
FunctionBegin.l
; Location of the first character for the function name.
FunctionEnd.l
; Location of the last character for the function name.
FunctionNamed.s
;
LastIsOpen.b
;
CountParanthesis.l
;
CountParameters.l
;
Length.l
; The length of the expression.
Result.s
;}
;{ Set ASM Equivalents
!r_Expression equ esp
!r_Closed equ esp+28
!r_CountParanthesis equ esp+48
!r_FunctionBegin equ esp+32
!r_Length equ esp+56
!r_Opened equ esp+24
!r_Position equ esp+8
!r_LastIsOpen equ esp+44
;}
;
!add_xs_EvalBegin:
;
!MOV edx, 0
;
!MOV esi, dword[r_Expression]
; Store the address of the expression string.
!DEC esi
;
;{ Locate paranthesis and get the string length.
!add_xs_ExpOpenParan:
;
!INC esi
;
!INC edx
;
!MOVSX eax, byte[esi]
;
!CMP eax, 0
!JE add_xs_ExpOpenParanDone
; Catch the end of line character.
!CMP eax, 40
!JNE @f
; Test for the open paranthesis character.
!INC dword[r_CountParanthesis]
!MOV byte[r_LastIsOpen], 1
!MOV dword[r_Opened], edx
!
!JMP add_xs_ExpOpenParan
; Process the next character.
!@@:
; The character was not the open paranthesis character.
!CMP eax, 41
!JNE add_xs_ExpOpenParan
; Test for the closed paranthesis character.
!DEC dword[r_CountParanthesis]
!CMP byte[r_LastIsOpen], 1
!JNE @f
;
!MOV dword[r_Closed], edx
!MOV byte[r_LastIsOpen], 0
;
!@@:
;
!JMP add_xs_ExpOpenParan
;
!add_xs_ExpOpenParanDone:
; Finished locating open/closed paranthesis.
!MOV dword[r_Length], edx
;
;}
;
If CountParanthesis : ProcedureReturn "Imbalanced Paranthesis Error" : EndIf
; The number of open and closed paranthesis do not match. Return an error. Ex: "((2 + 3) + 4"
!DEC dword[r_Length]
; Ignore the EOL character.
While Opened
; Test if paranthesis exist.
;{ Locate Next Closed Paranthesis
If Closed = 0
; Special case for repeat paranthesis expression solving. Closed is set to 0 whenever an expression within
; paranthesis is solved.
Closed = Opened
;
While *Position - @Expression < Length
;
!INC dword[r_Position]
;
If PeekB(*Position) = 41 : Break : EndIf
;
!INC dword[r_Closed]
;
Wend
;
!INC dword[r_Closed]
; Ensure the index of the closed paranthesis is one based.
EndIf
;}
*Position = @Expression + Opened - 1
; Move to the open paranthesis.
If PeekB(*Position - 1) > 33 And *Position > @Expression
;{ Function Handling
; The open paranthesis is not the first character in the string and a non-space, valid character exists before the paranthesis.
FunctionBegin = Opened : FunctionEnd = Opened - 1
; Set the beginning and ending index for the function name.
HoldChar = PeekB(*Position)
; Store the current character.
While *Position > @Expression
; Loop backward through the expression to find the beginning of the function name.
!DEC dword[r_Position]
;
HoldChar = PeekB(*Position)
;
If HoldChar < 33
Break
ElseIf HoldChar = 94
Break
ElseIf HoldChar = 42
Break
ElseIf HoldChar = 47
Break
ElseIf HoldChar = 37
Break
ElseIf HoldChar = 43
Break
ElseIf HoldChar = 45
Break
EndIf
;
!DEC dword[r_FunctionBegin]
; Decrease the index of the function name.
Wend
;
FunctionNamed = Mid(Expression, FunctionBegin, FunctionEnd - FunctionBegin + 1)
; Store the name of the function.
HoldExpression = Mid(Expression, Opened + 1, Closed - Opened - 1)
; Store the expression within the paranthesis.
CountParameters = CountString(HoldExpression, ",") + 1
; Store the one based number of parameters.
HoldParameters = ""
;
For iLoop = 1 To CountParameters
; Loop through the parameters.
HoldParameters = HoldParameters + xs_Solve(StringField(HoldExpression, iLoop, ","), -1)
;
If iLoop < CountParameters : HoldParameters + "," : EndIf
;
Next iLoop
;
Result = xs_SolveFunction_test(FunctionNamed, HoldParameters, CountParameters)
; Solve the function.
If Left(Result, 3) = "ERR" : ProcedureReturn Result : EndIf
; Return any error messages.
Expression = Mid(Expression, 1, FunctionBegin - 1) + Result + Mid(Expression, Closed + 1, Length - Closed)
; Create the new expression.
Opened = FunctionBegin
; The function name is the equivalent of the open paranthesis. A new open paranthesis can only exist before
; the beginning of the function name.
;}
Else
; No character exists before the open paranthesis - not a function.
HoldExpression = Mid(Expression, Opened + 1, Closed - Opened - 1)
; Store the expression within the paranthesis.
Result = xs_Solve(HoldExpression, Closed - Opened - 1)
; Solve the expression.
If Left(Result, 3) = "ERR" : ProcedureReturn Result : EndIf
; Return any error messages.
Expression = Mid(Expression, 1, Opened - 1) + Result + Mid(Expression, Closed + 1, Length - Closed)
; Create the new expression.
EndIf
;
*Position = @Expression + Opened - 1
;
Closed = 0
; The closed paranthesis index is no longer valid.
Repeat
; Loop backward through the expression to find the next open paranthesis.
!DEC dword[r_Position]
;
If PeekB(*Position) = 40 : Break : EndIf
;
!DEC dword[r_Opened]
; Decrease the index of the open paranthesis. This will be 0 if no more open paranthesis are located.
Until *Position < @Expression
;
If Opened
;
!DEC dword[r_Opened]
; Ensure the index of the open paranthesis is 1 based.
EndIf
;
Wend
;
Result = xs_Solve(Expression, Length)
; Solve the expression.
ProcedureReturn Result
; Return the result of the expression.
EndProcedure
Procedure.f GetVariable(var.s)
If var = "X" : ProcedureReturn X : EndIf
If var = "Y" : ProcedureReturn Y : EndIf
EndProcedure
Procedure IsVariable(var.s)
If var = "X" : ProcedureReturn 1 : EndIf ; 1
If var = "Y" : ProcedureReturn 1 : EndIf
ProcedureReturn 0
EndProcedure
Procedure IsCommande(com.s)
If com = "Int " : ProcedureReturn 1 : EndIf ; 4
If com = "Abs " : ProcedureReturn 1 : EndIf
If com = "Rnd " : ProcedureReturn 1 : EndIf
If com = "Arg " : ProcedureReturn 1 : EndIf
If com = "Frac " : ProcedureReturn 1 : EndIf ; 5
If com = "Intg " : ProcedureReturn 1 : EndIf
EndProcedure
Procedure.s Insert(string.s, StringToInsert.s, index.l); insert une chaine dans une autre apres le caractere a l'index
ProcedureReturn Left(string, index) + StringToInsert + Right(string, Len(string) - index)
EndProcedure
ProcedureDLL.s EvaluateVariable(expression.s, x12.f, y12.f, etat_first)
If etat_first = 1
X = x12
Y = y12
EndIf
Debug "--Evaluation"
results.s = ""
index = 0
While index < Len(expression)
index + 1
ascvalue = Asc(Mid(expression, index, 1))
If ascvalue < 40 Or ascvalue > 57 Or ascvalue = 44
taille = 1
taillem = 0
oui = 0
For commande = 1 To 43
If commande = 29 : taille = 2 : EndIf
If commande = 33 : taille = 3 : EndIf
If commande = 34 : taille = 4 : EndIf
If commande = 35 : taille = 6 : EndIf
If commande = 38 : taille = 4 : EndIf
If commande = 42 : taille = 5 : EndIf
If IsVariable(Mid(expression, index, taille)) = 1
taillem = taille
oui = 1
EndIf
If IsCommande(Mid(expression, index, taille)) = 1
taillem = taille
oui = 2
EndIf
Next
taille = taillem
If oui = 0
Debug "--Expression non correcte : caractere non autorisé :" + Chr(ascvalue) + " et expression :" + expression
Debug "--End Evaluation"
ProcedureReturn "non correcte"
; ProcedureReturn #erreur
EndIf
first_part.s = Left(expression, index - 1)
second_part.s = Mid(expression, index + taille, Len(expression))
If oui = 1
middle.s = StrF(GetVariable(Mid(expression, index, taille)))
If (Asc(second_part) < 40 Or Asc(second_part) > 57 Or Asc(second_part) = 44) And Asc(second_part) <> 0
middle + "*"
EndIf
expression = first_part.s + middle.s + second_part.s
index + Len(middle) - 1
ElseIf oui = 2
middle.s = Mid(expression, index, taille)
par_1 = 0
For curs = 1 To Len(first_part)
char.s = Mid(first_part, curs, 1)
If char = "(" : par_1 + 1 : EndIf
If char = ")" : par_1 - 1 : EndIf
Next
par = 0
For curs = 1 To Len(second_part)
char.s = Mid(second_part, curs, 1)
If char = "(" : par + 1 : EndIf
If char = ")" : par - 1 : EndIf
If (char = "+" Or char = "-" Or char = "*" Or char = "/" Or char = ")") And ((par = 0 And par_1 = 0) Or (par < 0 And par_1 > 0))
If par < 0 And par_1 > 0
curs - 1
EndIf
Break
EndIf
Next
If par + par_1 <> 0 And ((char = "+" Or char = "-" Or char = "*" Or char = "/" Or char = ")") And ((par = 0 And par_1 = 0) Or (par < 0 And par_1 > 0))) = 0
If par + par_1 < 0 : Debug "--parenthese fermante en trop :" + first_part + second_part : Else : Debug "--parenthese ouvrante en trop :" + first_part + second_part : EndIf
Debug "--End Evaluation"
ProcedureReturn "non correcte"
; ProcedureReturn #erreur
EndIf
parametres.s = Mid(second_part, 1, curs)
second_part = Mid(second_part, curs + 1, Len(second_part))
parametres = StrF(EvaluateVariable(parametres, 0, 0, 0))
If parametres = "non correcte"
Debug "--parametre non correct :" + parametres
Debug "--End Evaluation"
ProcedureReturn "non correcte"
; ProcedureReturn #erreur
EndIf
expression = first_part + ReplaceString(middle, " ", "(") + parametres + ")" + second_part
index + Len(first_part + ReplaceString(middle, " ", "(") + parametres + ")")
EndIf
ElseIf ascvalue >=48 And ascvalue <= 57
ascvalue1 = Asc(Mid(expression, index + 1, 1))
If (ascvalue1 < 40 Or ascvalue1 > 57 Or ascvalue1 = 44) And ascvalue1 <> 0
expression = Insert(expression, "*", index)
EndIf
EndIf
Wend
expression = ReplaceSigne(expression)
expression_1.s = ReplaceString(expression, "Int(", "(")
expression_1.s = ReplaceString(expression_1, "Abs(", "(")
expression_1.s = ReplaceString(expression_1, "Rnd(", "(")
expression_1.s = ReplaceString(expression_1, "Arg(", "(")
expression_1.s = ReplaceString(expression_1, "Frac(", "(")
expression_1.s = ReplaceString(expression_1, "Intg(", "(")
expression_1.s = ReplaceString(expression_1, "-", "")
If xs_Valid_test(expression_1.s) = "Expression correcte"
results = xs_Evaluate_test(expression)
Debug "--Expression correcte : resultat :" + results
Else
Debug "--Expression non correcte :" + expression
Debug "--End Evaluation"
ProcedureReturn "non correcte"
; ProcedureReturn #erreur
EndIf
Debug "--End Evaluation"
ProcedureReturn results
; ProcedureReturn ValF(results)
EndProcedure
Debug EvaluateVariable("-XY", 10, -5, 1)