1. Accueil
  2. Visual Basic / VB.NET
  3. Sources Visual Basic / VB.NET
  4. Sources API
  5. Module pour calcule numérique d'une chaine de caractères (comme pour un textbox)

Module pour calcule numérique d'une chaine de caractères (comme pour un textbox)

Soyez le premier à donner votre avis sur cette source.

Vue 7 530 fois - Téléchargée 308 fois

Télécharger le projet
Commenter

Description

Voila un programme qui permet de calculer une expression numérique provenant d'un textbox par exemple, ou de toute chaine de caractère de type string. Donc il gere ,en plus des opérations courantes (+,-,/,*,^), les fonctions cos, sin, tan, ln, exp, il gere aussi des calcules avec paranthèses, et il gére aussi 2 variable (x et z)....

Et puis vous avez qu'a aller voir le code.

C'est les fonctions qui m'ont servis pour mon graph 3d, donc certains le reconnaitront peut-être, j'y ai rajouté des commentaires et changé 2-3 trucs.

Source / Exemple : 


'à placer dans un module

Public Function Calcul(Expr As Variant, Optional VarX As Variant, Optional VarZ As Variant) As Variant
Dim ParD, ParG, ExprPar

Expr = Replace(Expr, ".", ",")
Expr = Replace(Expr, "-c", "-1*c")
Expr = Replace(Expr, "-s", "-1*s")
Expr = Replace(Expr, "-t", "-1*t")
Expr = Replace(Expr, "-e", "-1*e")
Expr = Replace(Expr, "-x", "-1*x")
Expr = Replace(Expr, "-z", "-1*z")
Expr = Replace(Expr, "-l", "-1*l")
Expr = Replace(Expr, "-(", "-1*(")

For n = 0 To 9 Step 1
Expr = Replace(Expr, n & "c", n & "*c")
Expr = Replace(Expr, n & "s", n & "*s")
Expr = Replace(Expr, n & "t", n & "*t")
Expr = Replace(Expr, n & "e", n & "*e")
Expr = Replace(Expr, n & "x", n & "*x")
Expr = Replace(Expr, n & "z", n & "*z")
Expr = Replace(Expr, n & "l", n & "*l")
Expr = Replace(Expr, n & "(", n & "*(")
Next

Expr = Replace(Expr, "x", CStr(VarX)) 'cherche x dans l'expression et le ramplace par sa valeur
Expr = Replace(Expr, "z", CStr(VarZ)) 'idem pour z
Expr = Replace(Expr, " ", "")
Expr = Replace(Expr, "e", CCur(Exp(1)))
Expr = Replace(Expr, "ln", "l")
Expr = Replace(Expr, "cos", "c")
Expr = Replace(Expr, "sin", "s")
Expr = Replace(Expr, "tan", "t")

n = 0
Do
On Error GoTo Impossible 'permet de ne pas fermer le programme en cas d'erreur ex : pour 5/0
DoEvents
n = n + 1
If Mid(Expr, n, 1) = "(" Then ParG = n 'releve la dernier paranthèse ouverte
If Mid(Expr, n, 1) = ")" Then 'releve la 1er paranthèse fermée
    ParD = n
    ExprPar = Mid(Expr, ParG + 1, ParD - 1 - ParG) 'releve le morceau d'expression numérique entre les paranthèses
    ExprPar = Analyse(ExprPar, VarX, VarZ) 'calcule l'expression entre les paranthèse
    Expr = Left(Expr, ParG - 1) & ExprPar & Right(Expr, Len(Expr) - ParD) 'remplace l'expression entre les paranthèses par sa valeur dans l'expression du départ
  n = 0
  ParG = 0
  ParD = 0
End If

If n >= Len(Expr) Then GoTo FinParanthese 'permet de sortir de la boucle quand il n'y a plus de paranthèse
Loop
FinParanthese:
Expr = Analyse(Expr, VarX, VarZ)
Calcul = Expr
GoTo Sortie
Impossible:
Calcul = "Erreur, opération interdite"
Sortie:
End Function

Public Function Analyse(Expr As Variant, Optional VarX As Variant, Optional VarZ As Variant) As Variant
'déclare les différentes variable utilisé dans la fonction
Dim ExprAna, Dernier, Suivant, ChercheSuiv, nSuiv, VarD, VarG, NewExpr As Double
Dim IndicOpéra As String

Depart:
Expr = Replace(Expr, "E", "*10^")

''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'cosinus'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Dernier = 0
n = 0
Suivant = 0
Do
DoEvents
  n = n + 1
  ExprAna = Mid(Expr, n, 1)
If ExprAna = Mid(Expr, n, 1) = "E" Then GoTo Depart
  If ExprAna = "c" Then 'permet de trouvé le cosinus
   nSuiv = n + 1
     Do
     DoEvents
     nSuiv = nSuiv + 1
     ChercheSuiv = Mid(Expr, nSuiv, 1)
     'cherche l'operateur suivant qui permetra de delimité ce qui fait partie du cosinus
       If ChercheSuiv = "*" Or ChercheSuiv = "/" Or ChercheSuiv = "-" Or ChercheSuiv = "+" Then
         Suivant = nSuiv
         GoTo FinSuivCos
       ElseIf nSuiv >= Len(Expr) Then
         Suivant = Len(Expr) + 1
         GoTo FinSuivCos
       End If
     Loop
    
FinSuivCos:
   VarD = Mid(Expr, n + 1, Suivant - n - 1)
   IndicOpéra = "cos"
   On Error GoTo Impossible
   NewExpr = CCur(Cos(CDbl(VarD))) 'calcule la valeur du cosinus
   'remplace l 'expression ou il y a le cosinus par la valeur trouvé dans l'expression principale
   Expr = Left(Expr, Dernier) & NewExpr & Right(Expr, Len(Expr) - (Suivant - 1))
   
   n = 0
   Dernier = 0
   GoTo Trigo
'''''''''''''''''''''''''''''''''''''''
'sinus '''''''''''''''''''''''
  ElseIf ExprAna = "s" Then
   nSuiv = n + 1
     Do
     DoEvents
     nSuiv = nSuiv + 1
     ChercheSuiv = Mid(Expr, nSuiv, 1)
       If ChercheSuiv = "*" Or ChercheSuiv = "/" Or ChercheSuiv = "-" Or ChercheSuiv = "+" Then
         Suivant = nSuiv
         GoTo FinSuivSin
       ElseIf nSuiv >= Len(Expr) Then
         Suivant = Len(Expr) + 1
         GoTo FinSuivSin
       End If
     Loop
    
FinSuivSin:
  
   VarD = Mid(Expr, n + 1, Suivant - n - 1)
      IndicOpéra = "sin"

  On Error GoTo Impossible
   NewExpr = CCur(Sin(CDbl(VarD)))
      

   Expr = Left(Expr, Dernier) & NewExpr & Right(Expr, Len(Expr) - (Suivant - 1))
   
   n = 0
   Dernier = 0
   GoTo Trigo
   
   '''''''''''''''''''''''''''''''''''''''
'tan '''''''''''''''''''''''
  ElseIf ExprAna = "t" Then
   nSuiv = n + 1
     Do
     DoEvents
     nSuiv = nSuiv + 1
     ChercheSuiv = Mid(Expr, nSuiv, 1)
       If ChercheSuiv = "*" Or ChercheSuiv = "/" Or ChercheSuiv = "-" Or ChercheSuiv = "+" Then
         Suivant = nSuiv
         GoTo FinSuivTan
       ElseIf nSuiv >= Len(Expr) Then
         Suivant = Len(Expr) + 1
         GoTo FinSuivTan
       End If
     Loop
    
FinSuivTan:

   VarD = Mid(Expr, n + 1, Suivant - n - 1)
   IndicOpéra = "tan"
On Error GoTo Impossible
   NewExpr = CCur(Tan(CDbl(VarD)))
      

   Expr = Left(Expr, Dernier) & NewExpr & Right(Expr, Len(Expr) - (Suivant - 1))
   
   n = 0
   Dernier = 0
   GoTo Trigo
   '''''''''''''''''''''''''''''''''''''''
'ln '''''''''''''''''''''''
  ElseIf ExprAna = "l" Then
   nSuiv = n + 1
     Do
     DoEvents
     nSuiv = nSuiv + 1
     ChercheSuiv = Mid(Expr, nSuiv, 1)
       If ChercheSuiv = "*" Or ChercheSuiv = "/" Or ChercheSuiv = "-" Or ChercheSuiv = "+" Then
         Suivant = nSuiv
         GoTo FinSuivLn
       ElseIf nSuiv >= Len(Expr) Then
         Suivant = Len(Expr) + 1
         GoTo FinSuivLn
       End If
     Loop
    
FinSuivLn:
  
   VarD = Mid(Expr, n + 1, Suivant - n - 1)
   IndicOpéra = "ln"
   On Error GoTo Impossible
   NewExpr = CCur(Log(CDbl(VarD)))
      

   Expr = Left(Expr, Dernier) & NewExpr & Right(Expr, Len(Expr) - (Suivant - 1))
   
   n = 0
   Dernier = 0
   GoTo Trigo
  End If

If (ExprAna = "*" Or ExprAna = "/" Or ExprAna = "-" Or ExprAna = "+") And n - Dernier > 1 Then Dernier = n
If n >= Len(Expr) Or (n >= 2 And Len(Expr) = 3) Then GoTo FinTrigo
Trigo:
Loop
FinTrigo:

''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'Exposant ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

Suivant = 0 'variable indiquant l'opérateur suivant
Dernier = 0 'variable indiquant le dernier opérateut
n = 1 'on commence à un car cela permet de sauter le 1er caractère
'de la chaine car si celui-ci est"-" il ne serat pas pris en compte
'donc ferat partie d'un nombre pour donner un nombre négatif
Do
DoEvents
  n = n + 1
  ExprAna = Mid(Expr, n, 1) 'donne le caractère de l'expression au niveau de n
  'exemple ;si n = 6 -> mid("25+69-9",n,1)= "-"
  'n=4 -> mid("25+69-9,n,2)= "69"
  If ExprAna = Mid(Expr, n, 1) = "E" Then GoTo Depart
  If ExprAna = "^" Then 'cherche les "^" dans la chaine de caractère
   nSuiv = n + 1
     Do
     DoEvents
     nSuiv = nSuiv + 1
     ChercheSuiv = Mid(Expr, nSuiv, 1)
'une fois trouvé cherche le suivant quelconque
       If ChercheSuiv = "^" Or ChercheSuiv = "*" Or ChercheSuiv = "/" Or ChercheSuiv = "-" Or ChercheSuiv = "+" Then
         Suivant = nSuiv
         GoTo FinSuivExp
       ElseIf nSuiv >= Len(Expr) Then
         Suivant = Len(Expr) + 1
         GoTo FinSuivExp
       End If
     Loop
FinSuivExp:
   VarG = Mid(Expr, Dernier + 1, n - Dernier - 1) 'permet de recuperer le nombre
   'entre le dernier operateur quelconque et "^".
 
   VarD = Mid(Expr, n + 1, Suivant - n - 1) 'ici entre "^" et l'opérateur suivant
 On Error GoTo Impossible
   NewExpr = CCur(CDbl(VarG) ^ CDbl(VarD)) 'ici on fait le calule, mais il faut transformer
   'les nombres en variable de type Currency

   
   Expr = Left(Expr, Dernier) & NewExpr & Right(Expr, Len(Expr) - (Suivant - 1)) 'ici on redonne la nouvelle expression après ce premier calule
   '               |         |bout expr.|            |
   '               |         |calulé    |            |
   'morceau expression avant |          |morceau d'expression aprés
   'le "dernier" opérateur   |          |l'operateur "suivant"
   '                         |          |
   n = 1
   Dernier = 0
   GoTo Exp
  End If
  
  'permette d'enregistré le position du dernier opérateur
If (ExprAna = "^" Or ExprAna = "*" Or ExprAna = "/" Or ExprAna = "-" Or ExprAna = "+") And n - Dernier > 1 Then Dernier = n
If n >= Len(Expr) Or (n >= 2 And Len(Expr) = 3) Then GoTo FinExp 'quitte la boucle lorsqu'il n'a plus d'exposant
Exp:
Loop
FinExp:

''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'multiplication'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Dernier = 0
n = 1
Suivant = 0
Do
DoEvents
  n = n + 1
  ExprAna = Mid(Expr, n, 1)
If ExprAna = Mid(Expr, n, 1) = "E" Then GoTo Depart
  If ExprAna = "*" Then
   nSuiv = n + 1
     Do
     DoEvents
     nSuiv = nSuiv + 1
     ChercheSuiv = Mid(Expr, nSuiv, 1)
       If ChercheSuiv = "*" Or ChercheSuiv = "/" Or ChercheSuiv = "-" Or ChercheSuiv = "+" Then
         Suivant = nSuiv
         GoTo FinSuivFois
       ElseIf nSuiv >= Len(Expr) Then
         Suivant = Len(Expr) + 1
         GoTo FinSuivFois
       End If
     Loop
    
FinSuivFois:
   VarG = Mid(Expr, Dernier + 1, n - Dernier - 1)
   VarD = Mid(Expr, n + 1, Suivant - n - 1)
   On Error GoTo Impossible
   NewExpr = CCur(CDbl(VarG) * CDbl(VarD))
      

   Expr = Left(Expr, Dernier) & NewExpr & Right(Expr, Len(Expr) - (Suivant - 1))
   
   n = 1
   Dernier = 0
   GoTo Prio
'''''''''''''''''''''''''''''''''''''''
'division '''''''''''''''''''''''
  ElseIf ExprAna = "/" Then
   nSuiv = n + 1
     Do
     DoEvents
     nSuiv = nSuiv + 1
     ChercheSuiv = Mid(Expr, nSuiv, 1)
       If ChercheSuiv = "*" Or ChercheSuiv = "/" Or ChercheSuiv = "-" Or ChercheSuiv = "+" Then
         Suivant = nSuiv
         GoTo FinSuivDiv
       ElseIf nSuiv >= Len(Expr) Then
         Suivant = Len(Expr) + 1
         GoTo FinSuivDiv
       End If
     Loop
    
FinSuivDiv:
   VarG = Mid(Expr, Dernier + 1, n - Dernier - 1)
   VarD = Mid(Expr, n + 1, Suivant - n - 1)
   IndicOpéra = "/"
   On Error GoTo Impossible
   NewExpr = CCur(CDbl(VarG) / CDbl(VarD))
      

   Expr = Left(Expr, Dernier) & NewExpr & Right(Expr, Len(Expr) - (Suivant - 1))
   
   n = 1
   Dernier = 0
   GoTo Prio
  End If

If (ExprAna = "*" Or ExprAna = "/" Or ExprAna = "-" Or ExprAna = "+") And n - Dernier > 1 Then Dernier = n
If n >= Len(Expr) Or (n >= 2 And Len(Expr) = 3) Then GoTo FinPrio
Prio:
Loop
FinPrio:

''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'Soustraction'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Dernier = 0
n = 1
Suivant = 0
Do
DoEvents
  n = n + 1
  ExprAna = Mid(Expr, n, 1)
If ExprAna = Mid(Expr, n, 1) = "E" Then GoTo Depart
  If ExprAna = "-" Then
   nSuiv = n + 1
     Do
     DoEvents
     nSuiv = nSuiv + 1
     ChercheSuiv = Mid(Expr, nSuiv, 1)
       If ChercheSuiv = "-" Or ChercheSuiv = "+" Then
         Suivant = nSuiv
         GoTo FinSuivMoins
       ElseIf nSuiv >= Len(Expr) Then
         Suivant = Len(Expr) + 1
         GoTo FinSuivMoins
       End If
     Loop
    
FinSuivMoins:
   VarG = Mid(Expr, Dernier + 1, n - Dernier - 1)
   
   VarD = Mid(Expr, n + 1, Suivant - n - 1)
   
  On Error GoTo Impossible
   NewExpr = CCur(CDbl(VarG) - CDbl(VarD))
    
   Expr = Left(Expr, Dernier) & NewExpr & Right(Expr, Len(Expr) - (Suivant - 1))
   n = 1
   Dernier = 0
   GoTo Second
'''''''''''''''''''''''''''''''''''''''
'Addition '''''''''''''''''''''''
  ElseIf ExprAna = "+" Then
   nSuiv = n + 1
     Do
     DoEvents
     nSuiv = nSuiv + 1
     ChercheSuiv = Mid(Expr, nSuiv, 1)
       If ChercheSuiv = "-" Or ChercheSuiv = "+" Then
         Suivant = nSuiv
         GoTo FinSuivPlus
       ElseIf nSuiv >= Len(Expr) Then
         Suivant = Len(Expr) + 1
         GoTo FinSuivPlus
       End If
     Loop
    
FinSuivPlus:
   VarG = Mid(Expr, Dernier + 1, n - Dernier - 1)
   VarD = Mid(Expr, n + 1, Suivant - n - 1)
  On Error GoTo Impossible
   NewExpr = CCur(CDbl(VarG) + CDbl(VarD))
      
   Expr = Left(Expr, Dernier) & NewExpr & Right(Expr, Len(Expr) - (Suivant - 1))
   
   n = 1
   Dernier = 0
   GoTo Second
  End If

If (ExprAna = "-" Or ExprAna = "+") And n - Dernier > 1 Then Dernier = n
If n >= Len(Expr) Or (n >= 2 And Len(Expr) = 3) Then GoTo FinSecond
Second:
Loop
FinSecond:

Analyse = Expr
GoTo Sortie
Impossible:

If IndicOpéra = "/" Then Analyse = "Opération interdite : " & VarG & "/" & VarD
If IndicOpéra = "ln" Then Analyse = "Opération interdite : " & "ln" & VarD
Sortie:
End Function
Télécharger le projet

Codes Sources

A voir également

Ajouter un commentaire Commentaires
mikaeloff Messages postés 33 Date d'inscription mardi 4 novembre 2003 Statut Membre Dernière intervention 4 décembre 2005
25 mars 2004 à 23:25
ça a l'air super !
mais je voudrais savoir comment faire pour recupere l'expression presente dans un textbox nomé text1 par exemple.
comment utiliser ces fonction ?
mikaeloff Messages postés 33 Date d'inscription mardi 4 novembre 2003 Statut Membre Dernière intervention 4 décembre 2005
25 mars 2004 à 23:25
ça a l'air super !
mais je voudrais savoir comment faire pour recupere l'expression presente dans un textbox nomé text1 par exemple.
comment utiliser ces fonction ?
S'inscrire maintenant

Vous n'êtes pas encore membre ?

inscrivez-vous, c'est gratuit et ça prend moins d'une minute !

Les membres obtiennent plus de réponses que les utilisateurs anonymes.

Le fait d'être membre vous permet d'avoir un suivi détaillé de vos demandes et codes sources.

Le fait d'être membre vous permet d'avoir des options supplémentaires.

Du même auteur (CausPupus)