Soyez le premier à donner votre avis sur cette source.
Vue 4 690 fois - Téléchargée 389 fois
'Programmé par Black Night 'Si vous trouver des bugs ou si vous avez des commentaires, n'hésitez pas à me mailer 'sur blnight2003@yahoo.fr 'Si vous voulez utilisez ce module dans un code, appelez la fonction calculerr(chaine as string) 'Ce module n'est que le noyau d'un petit d'un petit langage de script interprété 'que j'implémente à partir de VB6. Si vous voulez participer au projet, mailez-moi 'car parfois je galére Option Explicit Dim tabl() As String 'Tableau d'équation géré dynamiquement Dim buffer() As String 'Mémoire tampon servant dans la gestion des parentheses Private Const PUI As String = "^" 'Opérateur puissance : 1ère priorité Private Const MODD As String = "%" 'Opérateur modulo : 2ème priorité Private Const MUL As String = "*" 'Opérateur multiplication : 2ème priorité Private Const DIV As String = "/" 'Opérateur division : 2ème priorité Private Const PLU As String = "+" 'Opérateur addition : 3ème priorité Private Const MIN As String = "-" 'Opérateur soustraction : 3ème priorité Private Const PARA_O As String = "(" 'Parenthese ouverte Private Const PARA_F As String = ")" 'Parenthese fermée Private Const PUI10 As String = "E" 'Puissance 10 Private Const FIN As String = "F" ' Fin de l'équation Private PUI_RESTE As Boolean 'S'il reste des opérateurs puissances, PUI_RESTE=True Private MODD_RESTE As Boolean 'S'il reste des opérateurs modulo, MODD_RESTE=True Private MUL_RESTE As Boolean 'S'il reste des opérateurs mltiplication, MUL_RESTE=True Private DIV_RESTE As Boolean 'S'il reste des opérateurs division, PUI_RESTE=True Dim cara As String 'Chaine de caractère aidant à décomposer l'équation Dim erreurr As Boolean 'Détection des erreurs; = False si pas d'erreurs Dim PresenceParenthese As Boolean 'Précense de parentheses 'Dans les prochaines version : 'Gestion de calculs scientifiques 'Stockage des résulats dans des varaibles définies par l'utilisateur (en cours) Private Sub traite(chaine As String) 'Cette fonction décompose l'argument 'chaine' (équation) élément par élément : 'tant qu'elle ne rencontre pas de d'opérateur, elle stocke les chiffres les uns sur 'les autres dans la variable globale cara en supprimant les espaces. Dès qu'elle 'rencontre un opérateur, la fonction stocke la variable cara dans le première indice 'du tableau 'tabl', et ainsi de suite On Error GoTo erreur Dim i As Long 'Simple compteur de boucle for Dim curr As Long 'Compteur du tableau Dim CdblCarra As Single 'Variable qui stocke un nombre convertit de string vers double Dim longchaine As Long 'Longueur de la chaîne Dim cara_loc As String 'Caractère courant dans la chaîne Dim para1, para2 As Byte 'Compteur pour remplir tableau des parentheses Dim str As String Dim avant As String str = chaine para1 = 1 para2 = 1 longchaine = Len(str) Erase tabl curr = 1 If compt_para(str) = False Then MsgBox "Erreur de syntaxe : nombre de parenthèses ouvetres et fermées différent. Le résulat retourné peut être erronné.", vbCritical, "Erreur" erreurr = True Exit Sub End If 'Cette boucle décompose la chaine comme expliqué ci-dessus... cara = "" For i = 1 To longchaine 'On stocke la caractère courant dans la variable cara_loc (caractète local) avant = cara_loc cara_loc = Mid(str, i, 1) 'Cette instruction if vérifie si le premier caractère un '-' 'A NE PAS ENLEVER SOUS PEINE DE BUG !!!! If i = 1 And cara_loc = MIN Then cara = MIN End If If cara_loc = MIN And avant = PUI10 Then cara = cara & MIN GoTo 3 End If If cara_loc = PARA_F And avant = PARA_O Then MsgBox "Erreur de syntaxe.", vbCritical, "Erreur" erreurr = True Exit Sub End If 'Gestion d'exception : parenthese fermée suivit d'aucun opérateur ou d'aucune autre parenthèse fermée If avant = PARA_F And i <> longchaine And (cara_loc <> PUI And cara_loc <> MODD And cara_loc <> MUL And cara_loc <> DIV And cara_loc <> PLU And cara_loc <> MIN And cara_loc <> PARA_F) Then MsgBox "Erreur de syntaxe.", vbCritical, "Erreur" erreurr = True Exit Sub End If 'Gestion d'exception : parenthése ouverte précédée d'aucun opérateur ou d'aucune autre parenthèse fermée If cara_loc = PARA_O And i <> 1 And (avant <> PUI And avant <> MODD And avant <> MUL And avant <> DIV And avant <> PLU And avant <> MIN And avant <> PARA_O) Then MsgBox "Erreur de syntaxe.", vbCritical, "Erreur" erreurr = True Exit Sub End If If (avant = PUI Or avant = MODD Or avant = MUL Or avant = DIV Or avant = PLU Or avant = MIN Or avant = PARA_O) And cara_loc = MIN Then cara = MIN End If If cara_loc = PUI10 Then cara = cara & PUI10 'Si la caractère n'est pas un opérateur, alors on met cara_loc sur cara ElseIf Not cara_loc = PUI And Not cara_loc = MODD And Not cara_loc = MUL And Not cara_loc = DIV And Not cara_loc = PLU And Not cara_loc = MIN And Not cara_loc = PARA_O And Not cara_loc = PARA_F Then cara = cara & cara_loc CdblCarra = CDbl(cara) 'On convertit cara en type double ElseIf (cara_loc = PUI Or cara_loc = MODD Or cara_loc = MUL Or cara_loc = DIV Or cara_loc = PLU Or cara_loc = MIN Or cara_loc = PARA_F) And avant = PARA_F Then ReDim Preserve tabl(1 To curr) tabl(curr) = cara_loc curr = curr + 1 ElseIf cara_loc = PARA_O Then ReDim Preserve tabl(1 To curr) tabl(curr) = PARA_O curr = curr + 1 cara = "" ElseIf i <> 1 And cara <> MIN Then 'Sinon on stocke CdblCarra dans le tableau ReDim Preserve tabl(1 To curr) tabl(curr) = CdblCarra cara = "" cara = cara_loc curr = curr + 1 'et on fait suivre directement par l'opérateur dans la case suivante ReDim Preserve tabl(1 To curr) tabl(curr) = cara cara = "" curr = curr + 1 If cara_loc = PARA_F And i = longchaine Then ReDim Preserve tabl(1 To curr) tabl(curr) = FIN 'On met fin dans le tableau... GoTo 1 End If End If 3: Next i 'On recommence curr = curr + 1 ReDim Preserve tabl(1 To curr) tabl(curr - 1) = cara tabl(curr) = FIN Exit Sub 1: Exit Sub erreur: MsgBox Err.Description & ". Le résultat donné est erroné.", vbCritical, "Erreur" erreurr = True Exit Sub End Sub Private Sub cal() 'Cette procédure 'calcule' le tableau On Error GoTo erreur Dim DernierePos As Byte Dim i As Byte Dim j As Byte Dim k As Byte If erreurr = False Then 1: j = 1 PUI_RESTE = False MUL_RESTE = False MODD_RESTE = False DIV_RESTE = False PresenceParenthese = False 'Permet de vérifier les priorités et les parenthéses While Not Trim(tabl(j)) = FIN If tabl(j) = PUI Then PUI_RESTE = True If tabl(j) = MODD Then MODD_RESTE = True If tabl(j) = MUL Then MUL_RESTE = True If tabl(j) = DIV Then DIV_RESTE = True If tabl(j) = PARA_O Then PresenceParenthese = True j = j + 1 Wend 'Quand tout sera calculer, tabl(2)=FIN While Not Trim(tabl(2)) = FIN For i = 1 To UBound(tabl) Select Case tabl(i) Case Is = PARA_O 'Derniére position d'une parenthése ouverte dans le tableau DernierePos = i Case Is = PARA_F 'Gestion des parenthèses cara = "" tabl(i) = "" tabl(DernierePos) = "" Erase buffer For k = DernierePos + 1 To i - 1 cara = cara & tabl(k) tabl(k) = "" Next k k = 1 For k = 1 To UBound(tabl) ReDim Preserve buffer(1 To k) buffer(k) = tabl(k) Next k PresenceParenthese = False traite cara cal buffer(i) = tabl(1) Erase tabl k = 1 For k = 1 To UBound(buffer) ReDim Preserve tabl(1 To k) tabl(k) = buffer(k) Next k Call compress_tab GoTo 1 'Des qu'on rencontre un opérateur, on fait l'opération... Case Is = PUI If PresenceParenthese = False Then tabl(i) = CDbl(tabl(i - 1)) ^ CDbl(tabl(i + 1)) tabl(i - 1) = "" tabl(i + 1) = "" 'Puis on revient à une chaîne de caractères comme au départ Call compress_tab 'Et on recommance GoTo 1 End If 'Idem Case Is = MODD If PUI_RESTE = False And PresenceParenthese = False Then tabl(i) = CDbl(tabl(i - 1)) Mod CDbl(tabl(i + 1)) tabl(i - 1) = "" tabl(i + 1) = "" Call compress_tab GoTo 1 End If 'Idem Case Is = MUL If PUI_RESTE = False And PresenceParenthese = False Then tabl(i) = CDbl(tabl(i - 1)) * CDbl(tabl(i + 1)) tabl(i - 1) = "" tabl(i + 1) = "" Call compress_tab GoTo 1 End If 'Idem Case Is = DIV If PUI_RESTE = False And PresenceParenthese = False Then tabl(i) = CDbl(tabl(i - 1)) / CDbl(tabl(i + 1)) tabl(i - 1) = "" tabl(i + 1) = "" Call compress_tab GoTo 1 End If 'Idem Case Is = PLU If DIV_RESTE = False And MUL_RESTE = False And MODD_RESTE = False And PUI_RESTE = False And PresenceParenthese = False Then tabl(i) = CDbl(tabl(i - 1)) + CDbl(tabl(i + 1)) tabl(i - 1) = "" tabl(i + 1) = "" Call compress_tab GoTo 1 End If 'Idem Case Is = MIN If DIV_RESTE = False And MUL_RESTE = False And MODD_RESTE = False And PUI_RESTE = False And PresenceParenthese = False Then tabl(i) = CDbl(tabl(i - 1)) - CDbl(tabl(i + 1)) tabl(i - 1) = "" tabl(i + 1) = "" Call compress_tab GoTo 1 End If End Select Next i Wend End If Exit Sub erreur: MsgBox Err.Description & ". Le résultat donné peur être erroné.", vbCritical, "Erreur" erreurr = True Exit Sub End Sub Public Function calculerr(chaine As String) As Single 'Fonction principale à appeler On Error Resume Next erreurr = False 'Au début, on suppose qu'il n'y a pas d'erreur traite chaine 'On 'découpe' la chaine If erreurr = False Then 'Si il n'y a pas d'erreurs , alors le résulat est dans tabl(1) cal calculerr = CDbl(tabl(1)) Else 'Si il y a une erreur on renvoit 0 calculerr = 0 End If End Function Private Sub compress_tab() 'Cette procédure supprime les espaces Dim i i = 1 cara = "" Do While Not tabl(i) = FIN If tabl(i) <> "" Then cara = cara & tabl(i) End If i = i + 1 Loop traite (cara) End Sub Private Function compt_para(chaine As String) As Boolean 'Vérifie les parenthéses Dim i, j As Byte Dim cara_loc As String Dim para_ouv, para_fer As Byte para_ouv = 0 para_fer = 0 j = Len(chaine) PresenceParenthese = False For i = 1 To j cara_loc = Mid(chaine, i, 1) If cara_loc = PARA_O Then para_ouv = para_ouv + 1 If cara_loc = PARA_F Then para_fer = para_fer + 1 Next i If para_ouv <> para_fer Then compt_para = False Exit Function End If If para_ouv <> 0 Then PresenceParenthese = True compt_para = True End Function
12 mai 2004 à 20:01
11 mai 2004 à 10:11
3 mai 2003 à 16:33
Le site de mon projet :
http://www.geocities.com/blnight2003/index.html
3 mai 2003 à 16:07
2 mai 2003 à 20:03
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.