|
 Trouver une ressource
Vous ne trouvez pas de réponse à votre problème ? Alors posez la question dans le forum. Souvenez-vous qu'il n'y a jamais de question bête, mais rester dans l'ignorance parce que l'on n'ose pas poser une question, ça c'est une erreur !
 INTERPRÈTEUR DE FORMULE
 Information sur la source
 Description
Je cherchais quelque chose pour pouvoir dessiner des fonctions, mon problèmes résidait dans l'interprétation de la formule (par exemple l'utilisateur devait pouvoir entrer tel quel "y=3*x^5+2*x^4-3*x^2+5" et le prog dessine) et je trouvais pas. J'ai d'abord bricolé un système ou mon prog écrivait une page html avec un vbscript dedans, le vbscript devant renvoyer comme titre du doc la réponse de la formule, et ensuite, je le récupérais grâce au controle dhtmledit, mais mon problème était alors que c'était TRES lent. Donc je me suis lancé dans une fonction permettant d'analyser une formule et de renvoyer son résultat. J'avais posé une question ici pour savoir si ca n'avait pas déjà été fait mais j'ai pas trouvé... C'est mon premier code, soyez indulgents, mais si vous avez des idées pour aller plus vite, faites m'en part...
 Source
- Type Operator
- Op As String
- Prior As Integer
- Location As Long
- End Type
-
- Function Eval(Formule As String) As Double
- Dim f As String, i As Long, NOp As Long, buf As String
- Dim Oper() As Operator, BufOp As Operator, CrntC As Long, Ordered As Boolean
- Dim RStr As String, LStr As String, h As Long
- f = Replace(Formule, " ", "")
-
- f = Replace(f, "pi", "3.1415926535897932")
-
- If InStr(1, f, "sin(") > 0 Then 'Interprétation de la fonction sinus
- h = 1
- i = InStr(1, f, "sin(")
- While Mid(f, i, 1) <> ")" And h <> 0
- If Mid(f, i, 1) = "(" Then h = h + 1
- If Mid(f, i, 1) = ")" Then h = h - 1
- i = i + 1
- If i > Len(f) Then
- MsgBox "Erreur de parenthèses..."
- Exit Function
- End If
- Wend
- i = i - InStr(1, f, "sin(")
- Eval = Eval(Left(f, InStr(1, f, "sin(") - 1) & Str2(Sin(Eval(Mid(f, InStr(1, f, "sin(") + 4, i - 4)))) & Right(f, Len(f) - (i + InStr(1, f, "sin("))))
- Exit Function
- End If
-
- If InStr(1, f, "cos(") > 0 Then 'Interprétation de la fonction cosinus
- h = 1
- i = InStr(1, f, "sin(")
- While Mid(f, i, 1) <> ")" And h <> 0
- If Mid(f, i, 1) = "(" Then h = h + 1
- If Mid(f, i, 1) = ")" Then h = h - 1
- i = i + 1
- If i > Len(f) Then
- MsgBox "Erreur de parenthèses..."
- Exit Function
- End If
- Wend
- i = i - InStr(1, f, "sin(")
- Eval = Eval(Left(f, InStr(1, f, "sin(") - 1) & Str2(Cos(Eval(Mid(f, InStr(1, f, "sin(") + 4, i - 4)))) & Right(f, Len(f) - (i + InStr(1, f, "sin("))))
- Exit Function
- End If
-
- If InStr(1, f, "tan(") > 0 Then 'Interprétation de la fonction tangeante
- h = 1
- i = InStr(1, f, "sin(")
- While Mid(f, i, 1) <> ")" And h <> 0
- If Mid(f, i, 1) = "(" Then h = h + 1
- If Mid(f, i, 1) = ")" Then h = h - 1
- i = i + 1
- If i > Len(f) Then
- MsgBox "Erreur de parenthèses..."
- Exit Function
- End If
- Wend
- i = i - InStr(1, f, "sin(")
- Eval = Eval(Left(f, InStr(1, f, "tan(") - 1) & Str2(Cos(Eval(Mid(f, InStr(1, f, "sin(") + 4, i - 4)))) & Right(f, Len(f) - (i + InStr(1, f, "sin("))))
- Exit Function
- End If
-
- NOp = 0
- For i = 1 To Len(f) 'NOp = nombre d'opérateur, cette boucle les compte
- buf = Mid(f, i, 1)
- If buf = "*" Or buf = "-" Or buf = "+" Or buf = "/" Or buf = "^" Or buf = "(" Then NOp = NOp + 1
- Next
- If NOp = 1 Then
- If InStr(1, f, "*") > 0 Then
- Eval = Val(Left(f, InStr(1, f, "*") - 1)) * Val(Right(f, Len(f) - InStr(1, f, "*")))
- ElseIf InStr(1, f, "-") > 0 Then
- Eval = Val(Left(f, InStr(1, f, "-") - 1)) - Val(Right(f, Len(f) - InStr(1, f, "-")))
- ElseIf InStr(1, f, "/") > 0 Then
- Eval = Val(Left(f, InStr(1, f, "/") - 1)) / Val(Right(f, Len(f) - InStr(1, f, "/")))
- ElseIf InStr(1, f, "+") > 0 Then
- Eval = Val(Left(f, InStr(1, f, "+") - 1)) + Val(Right(f, Len(f) - InStr(1, f, "+")))
- ElseIf InStr(1, f, "(") > 0 Then
- Eval = Val(Mid(f, 2))
- ElseIf InStr(1, f, "^") > 0 Then
- Eval = Val(Left(f, InStr(1, f, "^") - 1)) ^ Val(Right(f, Len(f) - InStr(1, f, "^")))
- End If
- Exit Function
- ElseIf NOp = 0 Then
- Eval = Val(Formule)
- Exit Function
- Else
- ReDim Oper(NOp)
- CrntC = 1
- For i = 1 To Len(f)
- Select Case Mid(f, i, 1)
- Case "("
- BufOp.Location = i
- BufOp.Op = "("
- BufOp.Prior = 0
- Oper(CrntC) = BufOp
- CrntC = CrntC + 1
- Case "^"
- BufOp.Location = i
- BufOp.Op = "^"
- BufOp.Prior = 1
- Oper(CrntC) = BufOp
- CrntC = CrntC + 1
- Case "/"
- BufOp.Location = i
- BufOp.Op = "/"
- BufOp.Prior = 2
- Oper(CrntC) = BufOp
- CrntC = CrntC + 1
- Case "*"
- BufOp.Location = i
- BufOp.Op = "*"
- BufOp.Prior = 3
- Oper(CrntC) = BufOp
- CrntC = CrntC + 1
- Case "+"
- BufOp.Location = i
- BufOp.Op = "+"
- BufOp.Prior = 4
- Oper(CrntC) = BufOp
- CrntC = CrntC + 1
- Case "-"
- BufOp.Location = i
- BufOp.Op = "-"
- BufOp.Prior = 4
- Oper(CrntC) = BufOp
- CrntC = CrntC + 1
- End Select
- Next
-
- 'TriBulle()
- While Ordered = False
- Ordered = True
- For i = 1 To NOp - 1
- If Oper(i).Prior > Oper(i + 1).Prior Then
- BufOp = Oper(i)
- Oper(i) = Oper(i + 1)
- Oper(i + 1) = BufOp
- Ordered = False
- End If
- Next
- Wend
-
- 'Localisation du premier bloc à traiter
- If Oper(1).Op = "(" Then
- h = 1
- i = Oper(1).Location
- While Mid(f, i, 1) <> ")" And h <> 0
- If Mid(f, i, 1) = "(" Then h = h + 1
- If Mid(f, i, 1) = ")" Then h = h - 1
- i = i + 1
- If i > Len(f) Then
- MsgBox "Erreur de parenthèses..."
- Exit Function
- End If
- Wend
- i = i - Oper(1).Location
- Eval = Eval(Left(f, Oper(1).Location - 1) & Str(Eval(Mid(f, Oper(1).Location + 1, i - 1))) & Right(f, Len(f) - (i + Oper(1).Location)))
- Else
- i = Oper(1).Location - 1
- While Mid(f, i, 1) <> "+" And Mid(f, i, 1) <> "*" And Mid(f, i, 1) <> "-" And Mid(f, i, 1) <> "/" And Mid(f, i, 1) <> ")" And Mid(f, i, 1) <> "^" And i > 1
- i = i - 1
- Wend
- LStr = Mid(f, i, Oper(1).Location - i)
- i = Oper(1).Location + 1
- While Mid(f, i, 1) <> "+" And Mid(f, i, 1) <> "*" And Mid(f, i, 1) <> "-" And Mid(f, i, 1) <> "/" And Mid(f, i, 1) <> ")" And Mid(f, i, 1) <> "^" And i < Len(f)
- i = i + 1
- Wend
- RStr = Mid(f, Oper(1).Location + 1, i - Oper(1).Location - 1)
- Select Case Oper(1).Op
- Case "*"
- Eval = Eval(Left(f, Oper(1).Location - 1 - Len(LStr)) & Str2(Val(LStr) * Val(RStr)) & Right(f, Len(f) - (Oper(1).Location + Len(RStr))))
- Case "/"
- Eval = Eval(Left(f, Oper(1).Location - 1 - Len(LStr)) & Str2(Val(LStr) / Val(RStr)) & Right(f, Len(f) - (Oper(1).Location + Len(RStr))))
- Case "+"
- Eval = Eval(Left(f, Oper(1).Location - 1 - Len(LStr)) & Str2(Val(LStr) + Val(RStr)) & Right(f, Len(f) - (Oper(1).Location + Len(RStr))))
- Case "-"
- Eval = Eval(Left(f, Oper(1).Location - 1 - Len(LStr)) & Str2(Val(LStr) - Val(RStr)) & Right(f, Len(f) - (Oper(1).Location + Len(RStr))))
- Case "^"
- Eval = Eval(Left(f, Oper(1).Location - 1 - Len(LStr)) & Str2(Val(LStr) ^ Val(RStr)) & Right(f, Len(f) - (Oper(1).Location + Len(RStr))))
- End Select
- End If
- End If
- End Function
-
- Public Function Str2(Value As Double) As String 'pour éviter les . qui deviennent , etc
- Str2 = Replace(Format(Value, "#0.##########################################"), ",", ".")
- End Function
Type Operator
Op As String
Prior As Integer
Location As Long
End Type
Function Eval(Formule As String) As Double
Dim f As String, i As Long, NOp As Long, buf As String
Dim Oper() As Operator, BufOp As Operator, CrntC As Long, Ordered As Boolean
Dim RStr As String, LStr As String, h As Long
f = Replace(Formule, " ", "")
f = Replace(f, "pi", "3.1415926535897932")
If InStr(1, f, "sin(") > 0 Then 'Interprétation de la fonction sinus
h = 1
i = InStr(1, f, "sin(")
While Mid(f, i, 1) <> ")" And h <> 0
If Mid(f, i, 1) = "(" Then h = h + 1
If Mid(f, i, 1) = ")" Then h = h - 1
i = i + 1
If i > Len(f) Then
MsgBox "Erreur de parenthèses..."
Exit Function
End If
Wend
i = i - InStr(1, f, "sin(")
Eval = Eval(Left(f, InStr(1, f, "sin(") - 1) & Str2(Sin(Eval(Mid(f, InStr(1, f, "sin(") + 4, i - 4)))) & Right(f, Len(f) - (i + InStr(1, f, "sin("))))
Exit Function
End If
If InStr(1, f, "cos(") > 0 Then 'Interprétation de la fonction cosinus
h = 1
i = InStr(1, f, "sin(")
While Mid(f, i, 1) <> ")" And h <> 0
If Mid(f, i, 1) = "(" Then h = h + 1
If Mid(f, i, 1) = ")" Then h = h - 1
i = i + 1
If i > Len(f) Then
MsgBox "Erreur de parenthèses..."
Exit Function
End If
Wend
i = i - InStr(1, f, "sin(")
Eval = Eval(Left(f, InStr(1, f, "sin(") - 1) & Str2(Cos(Eval(Mid(f, InStr(1, f, "sin(") + 4, i - 4)))) & Right(f, Len(f) - (i + InStr(1, f, "sin("))))
Exit Function
End If
If InStr(1, f, "tan(") > 0 Then 'Interprétation de la fonction tangeante
h = 1
i = InStr(1, f, "sin(")
While Mid(f, i, 1) <> ")" And h <> 0
If Mid(f, i, 1) = "(" Then h = h + 1
If Mid(f, i, 1) = ")" Then h = h - 1
i = i + 1
If i > Len(f) Then
MsgBox "Erreur de parenthèses..."
Exit Function
End If
Wend
i = i - InStr(1, f, "sin(")
Eval = Eval(Left(f, InStr(1, f, "tan(") - 1) & Str2(Cos(Eval(Mid(f, InStr(1, f, "sin(") + 4, i - 4)))) & Right(f, Len(f) - (i + InStr(1, f, "sin("))))
Exit Function
End If
NOp = 0
For i = 1 To Len(f) 'NOp = nombre d'opérateur, cette boucle les compte
buf = Mid(f, i, 1)
If buf = "*" Or buf = "-" Or buf = "+" Or buf = "/" Or buf = "^" Or buf = "(" Then NOp = NOp + 1
Next
If NOp = 1 Then
If InStr(1, f, "*") > 0 Then
Eval = Val(Left(f, InStr(1, f, "*") - 1)) * Val(Right(f, Len(f) - InStr(1, f, "*")))
ElseIf InStr(1, f, "-") > 0 Then
Eval = Val(Left(f, InStr(1, f, "-") - 1)) - Val(Right(f, Len(f) - InStr(1, f, "-")))
ElseIf InStr(1, f, "/") > 0 Then
Eval = Val(Left(f, InStr(1, f, "/") - 1)) / Val(Right(f, Len(f) - InStr(1, f, "/")))
ElseIf InStr(1, f, "+") > 0 Then
Eval = Val(Left(f, InStr(1, f, "+") - 1)) + Val(Right(f, Len(f) - InStr(1, f, "+")))
ElseIf InStr(1, f, "(") > 0 Then
Eval = Val(Mid(f, 2))
ElseIf InStr(1, f, "^") > 0 Then
Eval = Val(Left(f, InStr(1, f, "^") - 1)) ^ Val(Right(f, Len(f) - InStr(1, f, "^")))
End If
Exit Function
ElseIf NOp = 0 Then
Eval = Val(Formule)
Exit Function
Else
ReDim Oper(NOp)
CrntC = 1
For i = 1 To Len(f)
Select Case Mid(f, i, 1)
Case "("
BufOp.Location = i
BufOp.Op = "("
BufOp.Prior = 0
Oper(CrntC) = BufOp
CrntC = CrntC + 1
Case "^"
BufOp.Location = i
BufOp.Op = "^"
BufOp.Prior = 1
Oper(CrntC) = BufOp
CrntC = CrntC + 1
Case "/"
BufOp.Location = i
BufOp.Op = "/"
BufOp.Prior = 2
Oper(CrntC) = BufOp
CrntC = CrntC + 1
Case "*"
BufOp.Location = i
BufOp.Op = "*"
BufOp.Prior = 3
Oper(CrntC) = BufOp
CrntC = CrntC + 1
Case "+"
BufOp.Location = i
BufOp.Op = "+"
BufOp.Prior = 4
Oper(CrntC) = BufOp
CrntC = CrntC + 1
Case "-"
BufOp.Location = i
BufOp.Op = "-"
BufOp.Prior = 4
Oper(CrntC) = BufOp
CrntC = CrntC + 1
End Select
Next
'TriBulle()
While Ordered = False
Ordered = True
For i = 1 To NOp - 1
If Oper(i).Prior > Oper(i + 1).Prior Then
BufOp = Oper(i)
Oper(i) = Oper(i + 1)
Oper(i + 1) = BufOp
Ordered = False
End If
Next
Wend
'Localisation du premier bloc à traiter
If Oper(1).Op = "(" Then
h = 1
i = Oper(1).Location
While Mid(f, i, 1) <> ")" And h <> 0
If Mid(f, i, 1) = "(" Then h = h + 1
If Mid(f, i, 1) = ")" Then h = h - 1
i = i + 1
If i > Len(f) Then
MsgBox "Erreur de parenthèses..."
Exit Function
End If
Wend
i = i - Oper(1).Location
Eval = Eval(Left(f, Oper(1).Location - 1) & Str(Eval(Mid(f, Oper(1).Location + 1, i - 1))) & Right(f, Len(f) - (i + Oper(1).Location)))
Else
i = Oper(1).Location - 1
While Mid(f, i, 1) <> "+" And Mid(f, i, 1) <> "*" And Mid(f, i, 1) <> "-" And Mid(f, i, 1) <> "/" And Mid(f, i, 1) <> ")" And Mid(f, i, 1) <> "^" And i > 1
i = i - 1
Wend
LStr = Mid(f, i, Oper(1).Location - i)
i = Oper(1).Location + 1
While Mid(f, i, 1) <> "+" And Mid(f, i, 1) <> "*" And Mid(f, i, 1) <> "-" And Mid(f, i, 1) <> "/" And Mid(f, i, 1) <> ")" And Mid(f, i, 1) <> "^" And i < Len(f)
i = i + 1
Wend
RStr = Mid(f, Oper(1).Location + 1, i - Oper(1).Location - 1)
Select Case Oper(1).Op
Case "*"
Eval = Eval(Left(f, Oper(1).Location - 1 - Len(LStr)) & Str2(Val(LStr) * Val(RStr)) & Right(f, Len(f) - (Oper(1).Location + Len(RStr))))
Case "/"
Eval = Eval(Left(f, Oper(1).Location - 1 - Len(LStr)) & Str2(Val(LStr) / Val(RStr)) & Right(f, Len(f) - (Oper(1).Location + Len(RStr))))
Case "+"
Eval = Eval(Left(f, Oper(1).Location - 1 - Len(LStr)) & Str2(Val(LStr) + Val(RStr)) & Right(f, Len(f) - (Oper(1).Location + Len(RStr))))
Case "-"
Eval = Eval(Left(f, Oper(1).Location - 1 - Len(LStr)) & Str2(Val(LStr) - Val(RStr)) & Right(f, Len(f) - (Oper(1).Location + Len(RStr))))
Case "^"
Eval = Eval(Left(f, Oper(1).Location - 1 - Len(LStr)) & Str2(Val(LStr) ^ Val(RStr)) & Right(f, Len(f) - (Oper(1).Location + Len(RStr))))
End Select
End If
End If
End Function
Public Function Str2(Value As Double) As String 'pour éviter les . qui deviennent , etc
Str2 = Replace(Format(Value, "#0.##########################################"), ",", ".")
End Function
 Conclusion
Bon heu j'ai été vite, y'a peu de traitement d'erreurs, fo pas lui envoyer autre chose que prévu (surtout qu'en utilisant cette technique de fonction récurente, votre espace pile souffrira vite du moindre bug...)
 Historique
- 10 août 2005 12:34:05 :
- Tites fautes dans les commentaires corrigées
 Sources du même auteur
 Sources de la même categorie
Sources en rapport avec celle ci
 Commentaires et avis
 Discussions en rapport avec ce code source dans le forum
utiliser une fonction [ par cire2003 ]
Salut, Est-ce que qqn c comment utiliser une fonction, car on ma dit que pour n'écrire qu'une seul fois une formule, exemple: bf10 au lieu de b
Fonction! [ par couriousous ]
ben c assez simple et en même temp compliqueé je voudrait savoir comment décoder une fonction que tappe un utilisateur dans une zone de text afin de
fonction Sub [ par coucou ]
J'ai un travail dans lequel je dois calculer le taux de change (je rentre le montant et une devise et je la veux dans une autre devise.Et mon résultat
calculer le temps !! aidez moi svp ! [ par tibo830 ]
Dans un programe que je devrait présenter en examen la semaine prochaine, je dois utiliser un fonction qui calcul le temps séparant une heur
formule mathématique.. [ par peug ]
J'ai ne chaine de caractère comme cela :sFormule = "2+3"J'aimerai avoir le résultat.Si je faitval(sFormule) VB me retourne 2 car il analyse
Anlyser une fonction mathématique pour ensuite la desiner [ par ggolp ]
Bonjour a tous,Je suis actuellement en train de coder un programme qui me déssine une fonction mathématique dans un repère xy (en VB6).J'ai tout d'abo
Conversion d'une Chaîne de Charactères en Formule Mathématique [ par Dragho ]
Salut, Je suis en train de réalisé un petit projet sur Access et je me retrouve coincé avec quelque chose qui semble simple à réaliser mais je ne conn
une fonction pour calculer un chiffre [ par seiya01 ]
voila je suis en train de me faire un petit logiciel pour calculer un numero fetiche mais je voudrais savoir s'il existe une fonction pour que le logi
Calculer le contenu d'une variable URGENT plz [ par letrucaso ]
Bonjour/Bonsoir,Voila mon probleme , mon programe reduit des intervalle pour trouver l'endroit ou la droite d'une fonction passe par les abscisses...
Comment fonctionne la fonction FormulaR1C1 [ par razmokets ]
Bonjour,Je débute la programmation sous Visual et j'ai besoin d'utiliser une formule pour transférer des données de Visual vers Excel. Quelqu'un peut-
|
 Téléchargements
Logiciels à télécharger sur le même thème :
|