Mon pc sait compter!

Soyez le premier à donner votre avis sur cette source.

Snippet vu 3 441 fois - Téléchargée 31 fois

Contenu du snippet

je sais, des sources similaires sont déjà présentes.
mais je voulais quand meme apporter ma contribution.
cette source est relativement simple à comprendre.
crée une form, un label nommé txt_expr, taper votre formule dedans et presser entré. le résultat s'affiche dans ce meme label.
exemple :
sqr(3*sin(2)^4+(2*cos(-1)+2!))
=2,26528310159094 pour mon prog
=2.26528310159 pour ma graph 65 ( en remplacant cos(2)^4 par: (cos(2))^2 car pour elle cos(2)^4=cos(2^4)
note : 2!=2, je l'ai mis juste pour montrer que factirielle est pris en charge.
/!\ : ne gère pas 1/0;sqr(-1)...
j'utilise err.raise lorsqu'il y a une erreur dans la formule.

Source / Exemple :


Option Explicit
'notes :
'-ce programmes utilises les memes règles de prioritées que la graph 65.
'=5*-3 n'est valude ni dans ce programme, ni en math, mais 5*(-3) l'est.
'signe ² acepté
'les fonction qui porten un nom(sin,cos...) doivent obligatoirement etre suivient d'une parenthèse.
'
'Opérateur :
'([{}])
',(virgule)
'a+b addition
'a-b soustraction
'a*b multiplication
'a/b division
'-a opposé
'a^b puissance
'a! factorielle
'cos(a);sin(a);tan(a);atn(a)(inverse tangente);sqr(a)(racine carré)
'cos²(a)...
Private Sub txt_expr_KeyPress(KeyAscii As Integer)
    If KeyAscii = 13 Then 'Si on a fait entrée alors
        txt_expr.Text = valeur(txt_expr.Text) 'on calcul la valeur de ce qui a été tappé
        txt_expr.SelStart = Len(txt_expr.Text) 'on place le curseur a la fin du resultat
        KeyAscii = 0 'ca c'est pour éviter un 'BIP'
    End If
End Sub

Private Function valeur(nb As String) As Double
    Dim i As Integer 'pour les boucles
    Dim par As Integer 'niveau de parenthèse actuel
    Dim parjustifie As Boolean 'les parenthèse externes sont-elles justifiées ?
                               '"(2+3)*(5-3)" <> "2+3)*(5-3" donc oui
                               '"(2+7*5-8)" = "2+7*5-8" donc non
'mise aux normes
    nb = Replace(nb, ",", ".")
    'i = InStr(1, LCase(nb), pi)
    'if
    nb = Replace(nb, "²", "^2")
    nb = Replace(nb, "[", "(")
    nb = Replace(nb, "]", ")")
    nb = Replace(nb, "{", "(")
    nb = Replace(nb, "}", ")")
    nb = Replace(nb, ")(", ")*(")
    For i = 0 To 9
        nb = Replace(nb, ")" & CStr(i), ")*" & CStr(i))
    Next
    For i = Asc("a") To Asc("z")
        nb = Replace(nb, ")" & Chr(i), ")*" & Chr(i))
    Next
    For i = Asc("A") To Asc("Z")
        nb = Replace(nb, ")" & Chr(i), ")*" & Chr(i))
    Next
'vérification de la validité de nb
    For i = 1 To Len(nb)
        Select Case Mid(nb, i, 1)
        Case ")": par = par - 1 'on rentre dans une parenthèse
        Case "(": par = par + 1 'on sort d'une parenthèse
        End Select
        If par < 0 Then Call Err.Raise(1, , "parenthèse incorecte")
    Next
    For i = 1 To Len(nb)
        If InStr(1, "0123456789./*-+^!()", Mid(nb, i, 1)) = 0 And (Asc(UCase(Mid(nb, i, 1))) < Asc("A") Or Asc(UCase(Mid(nb, i, 1))) > Asc("Z")) Then Call Err.Raise(1, , "caractère inconu :" & Mid(nb, i, 1))
    Next
    If InStr(1, "/*-+^!", Left(nb, 1)) = 1 Then Call Err.Raise(1, , Mid(nb, i, 1) & " trouvé en première position")
    i = 0
    Do
        i = InStr(i + 1, nb, "(")
        If i > 0 Then If InStr(i + 1, "/*-+^!", Mid(nb, i + 1, 1)) = i + 1 Then Call Err.Raise(1, , Mid(nb, i, 1) & " trouvé juste après '('.")
    Loop While i > 0
    i = 0
    Do
        i = InStr(i + 1, nb, ")")
        If i > 0 Then If InStr(i + 1, "/*-+^!", Mid(nb, i - 1, 1)) = i - 1 Then Call Err.Raise(1, , Mid(nb, i, 1) & " trouvé juste avant ')'.")
    Loop While i > 0
    For i = 1 To Len(nb) - 1
        If InStr(1, "/*-+^", Mid(nb, i, 1)) <> 0 And InStr(1, "/*-+^!", Mid(nb, i + 1, 1)) Then Call Err.Raise(1, , "2 opérateur succésif trouvé(avec le premier différent de '!').")
    Next
'suppression des parenthèses externes inutiles
    parjustifie = False
    While Not parjustifie And Left(nb, 1) = "(" And Right(nb, 1) = ")" 'tant qu'il peut y avoir des parentèses externes injustifier
        For i = 2 To Len(nb)
            Select Case Mid(nb, i, 1)
            Case ")": par = par + 1 'on rentre dans une parenthèse
            Case "(": par = par - 1 'on sort d'une parenthèse
            End Select
            If par < 0 Then parjustifie = True 'si en ommetant la première parenthèse par=-1 alors les parenthèses externes sont indispenssables
        Next
        If Not parjustifie Then nb = Mid(nb, 2, Len(nb) - 2) 'si les parenthèses externes sont supperflue, on les supprimes
    Wend
    If IsNumeric(Replace(nb, ".", ",")) Then valeur = Val(nb): Exit Function ' si nb est un nombre...
    
    '+
    par = 0
    For i = Len(nb) To 2 Step -1
        Select Case Mid(nb, i, 1)
        Case ")": par = par + 1
        Case "(": par = par - 1
        End Select
        If par = 0 Then If Mid(nb, i, 1) = "+" Then valeur = valeur(Left(nb, i - 1)) + valeur(Mid(nb, i + 1)): Exit Function
    Next
    '-
    par = 0
    For i = Len(nb) To 2 Step -1
        Select Case Mid(nb, i, 1)
        Case ")": par = par + 1
        Case "(": par = par - 1
        End Select
        If par = 0 Then
            If Mid(nb, i, 1) = "-" Then
                If i > 1 Then
                    valeur = valeur(Left(nb, i - 1)) - valeur(Mid(nb, i + 1))
                Else
                    valeur = -valeur(Mid(nb, 2))
                End If
                Exit Function
            End If
        End If
    Next
    '*
    par = 0
    For i = Len(nb) To 2 Step -1
        Select Case Mid(nb, i, 1)
        Case ")": par = par + 1
        Case "(": par = par - 1
        End Select
        If par = 0 Then If Mid(nb, i, 1) = "*" Then valeur = valeur(Left(nb, i - 1)) * valeur(Mid(nb, i + 1)): Exit Function
    Next
    '/
    par = 0
    For i = Len(nb) To 2 Step -1
        Select Case Mid(nb, i, 1)
        Case ")": par = par + 1
        Case "(": par = par - 1
        End Select
        If par = 0 Then If Mid(nb, i, 1) = "/" Then valeur = valeur(Left(nb, i - 1)) / valeur(Mid(nb, i + 1)): Exit Function
    Next
    '^
    par = 0
    For i = Len(nb) To 2 Step -1
        Select Case Mid(nb, i, 1)
        Case ")": par = par + 1
        Case "(": par = par - 1
        End Select
        If par = 0 Then If Mid(nb, i, 1) = "^" Then valeur = valeur(Left(nb, i - 1)) ^ valeur(Mid(nb, i + 1)): Exit Function
    Next
    '!(factorielle) (n!=1*2*3*...*n)
    par = 0
    For i = Len(nb) To 2 Step -1
        Select Case Mid(nb, i, 1)
        Case ")": par = par + 1
        Case "(": par = par - 1
        End Select
        If par = 0 Then
            If Mid(nb, i, 1) = "!" Then
                If i = Len(nb) Then
                    valeur = factorielle(valeur(Left(nb, Len(nb) - 1))): Exit Function
                Else
                    valeur = factorielle(valeur(Left(nb, i - 1))) * valeur(Mid(nb, i + 1)): Exit Function
                End If
            End If
        End If
    Next
    If LCase(Left(nb, 4)) = "cos(" Then valeur = Cos(valeur(Mid(nb, 4))): Exit Function
    If LCase(Left(nb, 4)) = "sin(" Then valeur = Sin(valeur(Mid(nb, 4))): Exit Function
    If LCase(Left(nb, 4)) = "tan(" Then valeur = Tan(valeur(Mid(nb, 4))): Exit Function
    If LCase(Left(nb, 4)) = "atn(" Then valeur = Atn(valeur(Mid(nb, 4))): Exit Function
    If LCase(Left(nb, 4)) = "sqr(" Then valeur = Sqr(valeur(Mid(nb, 4))): Exit Function
    If LCase(Left(nb, 4)) = "log(" Then valeur = Log(valeur(Mid(nb, 4))): Exit Function
    If LCase(Left(nb, 4)) = "exp(" Then valeur = Exp(valeur(Mid(nb, 4))): Exit Function
    If LCase(Left(nb, 5)) = "cos²(" Then valeur = Cos(valeur(Mid(nb, 5))) ^ 2: Exit Function
    If LCase(Left(nb, 5)) = "sin²(" Then valeur = Sin(valeur(Mid(nb, 5))) ^ 2: Exit Function
    If LCase(Left(nb, 5)) = "tan²(" Then valeur = Tan(valeur(Mid(nb, 5))) ^ 2: Exit Function
    If LCase(Left(nb, 5)) = "atn²(" Then valeur = Atn(valeur(Mid(nb, 5))) ^ 2: Exit Function
    If LCase(Left(nb, 5)) = "sqr²(" Then valeur = Sqr(valeur(Mid(nb, 5))) ^ 2: Exit Function
    If LCase(Left(nb, 5)) = "log²(" Then valeur = Log(valeur(Mid(nb, 5))) ^ 2: Exit Function
    If LCase(Left(nb, 5)) = "exp²(" Then valeur = Exp(valeur(Mid(nb, 5))) ^ 2: Exit Function
    
    Call Err.Raise(1, , "erreur non gérée : Ce n'est pas un nombre et aucun opérateur valide n'a été trouvé.")
End Function
Private Function factorielle(nb As Integer)
    Dim i As Integer
    factorielle = 1
    For i = 2 To nb
        factorielle = factorielle * i
    Next
End Function

Conclusion :


je compte l'intégrer un un de mes autre programme(c++) qui permet de calculer avec une précision de 10000 chiffres!

note :
taper sqr(3*sin(2)^4+(2*cos(-1)+2!)) dans google et vous obtiendrez 2.2652831

A voir également

Ajouter un commentaire

Commentaires

Messages postés
2
Date d'inscription
vendredi 16 février 2007
Statut
Membre
Dernière intervention
16 février 2007

c'est quoi ce programme de ouf !
Messages postés
116
Date d'inscription
jeudi 12 juillet 2001
Statut
Membre
Dernière intervention
23 juin 2005

je ne dit pas que VB garde 500 chifre apres la virgule mais je dit jusque que tout les calcul effectuée avec atn(1)*4 seron faussé par raport a ceux affectuée av pi si on fait par exemple * 1^500 par exemple...
mais c'est tellment insignifiant que bon...
Messages postés
30
Date d'inscription
mercredi 22 janvier 2003
Statut
Membre
Dernière intervention
16 novembre 2003

depuis quand vb garde 500 décimale???????????
PS : si tu veut être précis, utilise plutot http://www.cppfrance.com/code.aspx?ID=11163 (de moi aussi)
Messages postés
116
Date d'inscription
jeudi 12 juillet 2001
Statut
Membre
Dernière intervention
23 juin 2005

ha ouai c'est vrai qu'il y a une fonction lol !!
sinon au syrjet de pi=4*atn(1) c'est pas strictement juste, pour des calcul ok, mais dasn des aplicaiton scientifique comme il est le cas pr ce module il faut tt de meme savoir que Pi>atn(1)*4 (a 3.18e-531 prés) mais bon c'est tellement negligable mais il faut savoir que si ca nous importe quand meme ou pas (cas daplication scientifiques...)
voila @+
Messages postés
31
Date d'inscription
mardi 11 novembre 2003
Statut
Membre
Dernière intervention
28 juin 2005

ou tout simplement Abs(Nb) :-)
Afficher les 11 commentaires

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.