Une petite calculatrice

Présentation
Source, sur les bases d'une calculatrice en VB6
Téléchargement
2  1 
Téléchargé 269 fois Voir les 9 commentaires
Détails
Catégories : Divers
Avatar de SfJ5Rpw8
Expert éminent sénior
Voir tous les téléchargements de l'auteur
Licence : Autre
Date de mise en ligne : 29 décembre 2010




Avatar de bidou bidou - Expert éminent https://www.developpez.com
le 11/04/2009 à 0:24
Amusons nous alors.

Un clone de la calculette 'standard' windows, la aussi largement améliorable

http://bidou.developpez.com/outils/calc.frm

Avatar de ProgElecT ProgElecT - Rédacteur/Modérateur https://www.developpez.com
le 11/04/2009 à 14:02
Pour faire vivre un peu cette discussion.
La calculatrice

La page d'aide


Soyez tolérant, ce source je l’avais fait en prévision du passage a l’EURO, pour les commerciaux de là où je travaillais, je n’ai volontairement pas retouché le source, bien qu’il y aurai des améliorations à y faire, au vue de ce que j’ai appris depuis grâce à notre site préféré (DVP).
Tout ceci pour bien faire voir que l’on peut évoluer dans sa façon d’écrire du code au cours des années qui passent.
Avatar de Delbeke Delbeke - Membre expert https://www.developpez.com
le 11/04/2009 à 15:56
Personellement, j'ai toujours regrété qu'il n'existe pas de calculatrice programmable(Un comble pour un ordinateur). C'est un projet que j'avais abordé il y a bien lngtemps et que je n'ai jamais fini, mais il avait produit mon composant DiEval6.ocx. Seul rescapé de mes divagations d'alors.
Avatar de medkarim medkarim - Membre régulier https://www.developpez.com
le 05/05/2009 à 8:42
c'est bien cette discussion. elle m'a permis de sortir les vieux projets du carton.

ce n'est pas vraiment une calculatrice. mais peut servir comme telle. on peut lui faire faire autre chose.

Note: faut que MSscriptcontrol soit installé

Avatar de SfJ5Rpw8 SfJ5Rpw8 - Expert éminent sénior https://www.developpez.com
le 05/05/2009 à 21:17
merci medkarim pour ta contribution j'ai rajouté une image pour donnez des idées à d'autres contributeurs ...
Avatar de Xsat1 Xsat1 - Futur Membre du Club https://www.developpez.com
le 13/02/2010 à 17:51
petite participation de ma part.

La calculatrice la plus SIMPLE qu'il puisse exister, c'est d'ailleurs le tout premier programme que j'ai développé à l'école cette année !



Et ici une version un peu plus améliorée mais faites pas attention au design, je m'en fou un peu de ça dans mes débuts, j'essaie que le code soit impeccable



Voili voilou
Avatar de nathanscott nathanscott - Nouveau Candidat au Club https://www.developpez.com
le 17/08/2011 à 21:53
J'ai moi aussi un peut travailler sur une calculette. C'est pas encore parfait, mais je compte beaucoup sur votre aide et vos critiques pour la parfaire.
Avatar de SfJ5Rpw8 SfJ5Rpw8 - Expert éminent sénior https://www.developpez.com
le 18/08/2011 à 0:02
Citation Envoyé par nathanscott  Voir le message
J'ai moi aussi un peut travailler sur une calculette. C'est pas encore parfait, mais je compte beaucoup sur votre aide et vos critiques pour la parfaire.

Il s'agit d'une version .Net tu devrais poste ton code la partie "Téléchargez" de VB.Net ici :

http://vb.developpez.com/telecharger...rie/324/Divers
Avatar de Montor Montor - Membre éprouvé https://www.developpez.com
le 07/09/2012 à 22:02
C'est un peut trop tard pour moi mais rien empeche de mettre ma contribution "il s'agit d'un interpréteur d'expression "
bienque on ne utilise ce genre de code que dans rare cas.. créer un calculateur reste une excercice de style rien de plus

classe CLexer
Code : Sélectionner tout
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
Option Explicit 
Private Declare Function RtlMoveMemory Lib "kernel32" (ByVal Dest As Long, _ 
          ByVal Source As Long, ByVal iCount As Long) As Long 
Private Declare Function GetLocaleInfoA Lib "kernel32" (ByVal Locale As Long, ByVal LCType As Long, ByVal lpLCData As Long, ByVal cchData As Long) As Long 
Private Declare Function GetThreadLocale Lib "kernel32" () As Long 
Const LOCALE_SDECIMAL = &HE 
Public Enum TokenType 
   tkInvalid = 1000 
   tkNone = 0 
   tkWhite = 1 
   tkNumber = 2 
   tkIdent = 3 
   tkOpPow = 4 
   tkOpenExp = 5 
   tkCloseExp = 6 
   tkOpenBra = 7 
   tkCloseBra = 8 
   tkOpNot = 9 
   OpTermBegin = 100 
     tkOpOr = 101 
     tkOpXor = 102 
     tkOpPlus = 103 
     tkOpMinus = 104 
   OpTermEnd = 105 
   OpFacBegin = 200 
     tkOpMul = 201 
     tkOpMod = 202 
     tkOpDivF = 203 
     tkOpDiv = 204 
     tkOpAnd = 205 
     tkOpShl = 206 
     tkOpShr = 207 
   OpFacEnd = 208 
End Enum 
 
Private DecimalSep As Long 
Private fCode As String 
Private fPtr As Long 
Private fLen As Long 
Private fPos As Long 
Private fCopyStart As Long 
Private Char As Long 
Public CurrToken As TokenType 
 
Private Sub Class_Initialize() 
   'Récupère le séparateur décimal 
   If GetLocaleInfoA(GetThreadLocale, LOCALE_SDECIMAL, VarPtr(DecimalSep), 4) = 0 Then 
        DecimalSep = 44 
   End If 
End Sub 
 
Private Function GetChar(ByVal Idx As Long) As Long 
   If (Idx < fLen) And (Idx >= 0) Then 
     RtlMoveMemory VarPtr(GetChar), fPtr + Idx * 2, 1 
   End If 
   Char = GetChar 
End Function 
 
Private Function IdentType(ByVal AIdent As String) As TokenType 
      Select Case AIdent 
         Case "MOD": IdentType = tkOpMod 
         Case "DIV": IdentType = tkOpDiv 
         Case "AND": IdentType = tkOpAnd 
         Case "OR":  IdentType = tkOpOr 
         Case "XOR": IdentType = tkOpXor 
         Case "NOT": IdentType = tkOpNot 
         Case "SHL": IdentType = tkOpShl 
         Case "SHR": IdentType = tkOpShr 
      Case Else 
         IdentType = tkIdent 
      End Select 
End Function 
 
Private Function CharType(ByVal Char As Long) As TokenType 
   Select Case Char 
        Case 97 To 122, 65 To 90  ' a..z,A..Z alpha 
           CharType = tkIdent 
        Case 1 To 32: CharType = tkWhite   'blanc 
        Case 48 To 57: CharType = tkNumber '0..9 
        Case 45: CharType = tkOpMinus '- 
        Case 43: CharType = tkOpPlus  '+ 
        Case 42: CharType = tkOpMul   '* 
        Case 47: CharType = tkOpDivF  '/ 
        Case 94: CharType = tkOpPow   '^ 
        Case 40: CharType = tkOpenExp  '( 
        Case 41: CharType = tkCloseExp ') 
        Case 91: CharType = tkOpenBra  '[ 
        Case 93: CharType = tkCloseBra '] 
        Case 0:  CharType = tkNone     '#0 
        Case Else 
           CharType = tkInvalid 
   End Select 
End Function 
 
Private Sub LoadCharSet(ByVal AG As TokenType) 
    While CharType(GetChar(fPos + 1)) = AG 
       fPos = fPos + 1 
    Wend 
End Sub 
 
Private Function NextChar() As Integer 
     fPos = fPos + 1 
     NextChar = GetChar(fPos) 
End Function 
 
Public Function NextToken() As TokenType 
   While CharType(GetChar(fPos)) = tkWhite 
     fPos = fPos + 1 
   Wend 
   fCopyStart = fPos 
   CurrToken = CharType(Char) 
   Select Case CurrToken 
     Case tkIdent 
         LoadCharSet tkIdent 
     Case tkNumber 
     '[0-9]+ (.[0-9]+)? (E|e(-|+)? [0-9]+)? 
         LoadCharSet tkNumber 
         If Char = DecimalSep Then  ', or . 
            NextChar 
            LoadCharSet tkNumber 
         End If 
         If (Char = 69) Or (Char = 101) Then 'E e 
            NextChar 
            If (GetChar(fPos + 1) = 43) Or (Char = 45) Then ' - + 
                NextChar 
            End If 
            LoadCharSet tkNumber 
         End If 
   End Select 
   If fPos < fLen Then 
      fPos = fPos + 1 
   End If 
   If CurrToken = tkIdent Then 
      CurrToken = IdentType(Token) 
   End If 
   NextToken = CurrToken 
End Function 
 
Public Property Let Text(ACode As String) 
   fCode = ACode 
   fPtr = StrPtr(fCode) 
   fLen = Len(fCode) 
   fPos = 0 
   fCopyStart = 0 
End Property 
 
Public Property Get Token() As String 
Dim L As Long 
   L = fPos - fCopyStart 
   If (L <= fLen) And (L >= 0) Then 
    Token = Space(L) 
    RtlMoveMemory StrPtr(Token), fPtr + fCopyStart * 2, L * 2 
    Token = UCase$(Token) 
   End If 
End Property 
 
Public Property Get Position() As String 
    Position = fPos 
End Property
classe CExpression
Code : Sélectionner tout
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
Option Explicit 
 
Private fLexer As New CLexer 
 
Private Property Get CurrentToken() As TokenType 
     CurrentToken = fLexer.CurrToken 
End Property 
 
Private Function NextToken() As TokenType 
     NextToken = fLexer.NextToken 
     SynErr fLexer.CurrToken = tkInvalid 
End Function 
 
Private Function IsUnairyOp(ByVal AOP As TokenType) As Boolean 
   Select Case AOP 
        Case tkOpNot, tkOpPlus, tkOpMinus 
             IsUnairyOp = True 
   End Select 
End Function 
 
Private Function IsFacOperator(ByVal AOP As TokenType) As Boolean 
   IsFacOperator = ((AOP > OpFacBegin) And (AOP < OpFacEnd)) 
End Function 
 
Private Function IsTermOperator(ByVal AOP As TokenType) As Boolean 
   IsTermOperator = ((AOP > OpTermBegin) And (AOP < OpTermEnd)) 
End Function 
'<Factor> ::= (+|-)<Expression>| NUMBER | <Simple Call> | CONSTANT |'('<Expression>')' | '['<Expression>']' | NULL 
Private Function GetFactor() As Double 
Dim UOP As TokenType 
Dim Ret As Double 
Dim Ident As String 
    If IsUnairyOp(NextToken) Then 
       UOP = CurrentToken 
       Ret = GetExpression() 
       UnairyOperation UOP, Ret 
    Else 
      Select Case CurrentToken 
        Case tkNumber 
              Ret = CDbl(fLexer.Token) 
        Case tkIdent 
              Ident = fLexer.Token 
              If Not GetConstValue(Ret, Ident) Then 
                 SynErr NextToken <> tkOpenExp 
                 Ret = Simple_Call(GetExpression, Ident) 
                 SynErr CurrentToken <> tkCloseExp 
              End If 
        Case tkOpenExp 
              Ret = GetExpression 
              SynErr CurrentToken <> tkCloseExp 
        Case tkOpenBra 
              Ret = GetExpression 
              SynErr CurrentToken <> tkCloseBra 
        Case tkNone 
              Ret = 0 
        Case Else 
              SynErr 
      End Select 
      NextToken 
    End If 
    GetFactor = Ret 
End Function 
'<Exp> ::= <Factor>(^<Factor>)* 
Private Function GetExp() As Double 
     GetExp = GetFactor 
     While CurrentToken = tkOpPow 
           BinaryOperation CurrentToken, GetExp, GetFactor 
     Wend 
End Function 
'<Term> ::= <Exp> (DIV | * | / | MOD ... <Exp>)* 
Private Function GetTerm() As Double 
     GetTerm = GetExp 
     While IsFacOperator(CurrentToken) 
           BinaryOperation CurrentToken, GetTerm, GetExp 
     Wend 
End Function 
'<Expression>  ::= <Term> (+|- ... <Term>)* 
Private Function GetExpression() As Double 
     GetExpression = GetTerm 
     While IsTermOperator(CurrentToken) 
           BinaryOperation CurrentToken, GetExpression, GetTerm 
     Wend 
End Function 
'<Simple Call> ::= (SIN|COS|SQR|EXP|LOG ...) 
Private Function Simple_Call(Value As Double, ByVal AFuncName As String) As Double 
    Select Case AFuncName 
        Case "SIN": Simple_Call = Sin(Value) 
        Case "COS": Simple_Call = Cos(Value) 
        Case "SQR": Simple_Call = Sqr(Value) 
        Case "EXP": Simple_Call = Exp(Value) 
        Case "LOG": Simple_Call = Log(Value) 
        Case Else 
                SynErr 
     End Select 
End Function 
'<Const>  ::= (PI|...) 
Private Function GetConstValue(Value As Double, ByVal AConstName As String) As Boolean 
    GetConstValue = True 
    Select Case AConstName 
        Case "PI": Value = 3.14159265358979 
        Case Else 
             GetConstValue = False 
    End Select 
End Function 
 
Private Sub UnairyOperation(ByVal OP As TokenType, Value As Double) 
    Select Case OP 
        Case tkOpMinus: Value = -Value 
        Case tkOpNot: Value = Not Value 
        Case tkOpPlus: Value = Value 
        Case Else 
                SynErr 
     End Select 
End Sub 
 
Private Sub BinaryOperation(ByVal OP As TokenType, Value1 As Double, Value2 As Double) 
    Select Case OP 
        Case tkOpPlus:  Value1 = Value1 + Value2 
        Case tkOpMinus:  Value1 = Value1 - Value2 
        Case tkOpMul:  Value1 = Value1 * Value2 
        Case tkOpDivF: Value1 = Value1 / Value2 
        Case tkOpDiv:  Value1 = Value1 \ Value2 
        Case tkOpMod:  Value1 = Value1 Mod Value2 
        Case tkOpOr:   Value1 = Value1 Or Value2 
        Case tkOpAnd:  Value1 = Value1 And Value2 
        Case tkOpXor:  Value1 = Value1 Xor Value2 
        Case tkOpPow:  Value1 = Value1 ^ Value2 
        Case tkOpShl:  Value1 = Value1 * (2 * Value2) 
        Case tkOpShr:  Value1 = Value1 \ (2 * Value2) 
        Case Else 
                SynErr 
     End Select 
End Sub 
 
Public Function EvalExp(ByVal Text As String) As Double 
    fLexer.Text = Text 
    EvalExp = GetExpression 
    SynErr CurrentToken <> tkNone 
End Function 
 
Private Sub SynErr(Optional ByVal ARaise As Boolean = True) 
     If ARaise Then 
       Err.Description = "Erreur d'évaluation à la position " & CStr(fLexer.Position) 
       Err.Raise 1001 
     End If 
End Sub
Pour tester
Code : Sélectionner tout
1
2
Dim D As New CExpression 
   MsgBox D.EvalExp("10+20/2")
Developpez.com décline toute responsabilité quant à l'utilisation des différents éléments téléchargés.
Contacter le responsable de la rubrique Visual Basic 6