PureBasic

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

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)

Code : Tout sélectionner

Procedure.s GetName()

  Protected *texte.s
  Protected out.s

  texte = DLL_Fonction_Quite_Renvoi_PointeurChaine()
  Repeat
    n = PeekC(texte)
    out = out + Chr(n)
    texte=texte+1
  Until n=0
  ProcedureReturn out
EndProcedure

Code : Tout sélectionner

;=============================================

Prototype.l EvaluateVariable_(expression.s, x.f, y.f, etat.l)

Macro EvaluateVariable(expression, x, y, etat)
  PeekS(EvaluateVariable_(expression, x, y, etat))
EndMacro

If OpenLibrary(0, "Expression_valeurs_litterale.dll") 
  Global EvaluateVariable_.EvaluateVariable_ = GetFunction(0, "EvaluateVariable") 
EndIf

;=============================================

If IsLibrary(0)
  
  Debug EvaluateVariable("", 0.0, 0.0, 0)
  
  CloseLibrary(0)
  
EndIf

;=============================================

End