[HTA] Aide à l’énoncé d’un calcul

Salut

Ce petit programme permet, soit de faire un calcul directement, soit de créer un énoncé qui pourra être utilisé pour retrouvé la syntaxe d’une formule mathématique utilisable dans un programme quelconque.

2 exemples :
:fleche:HArccos(10)+Arccotan(5) = (Log(10+Sqr(10*10-1)))+(Atn(5)+2*Atn(1))
:fleche:VolumeSphère(5) = ((4*(4*Atn(1))*5^3)/3)
Comme vous pouvez le constater il est plus simple d’écrire VolumeSphère(5) que d’écrire ((4*(4*Atn(1))*5^3)/3)

Exemple pour VolumeSphère(x)
Si vous voulez écrire l’énoncé pour un programme, un copier/coller de l’énoncé complet (Enoncé reformaté (détails des formules dérivées)) ayant pour variable X (x étant le rayon de la sphère) vous permettra de gagner du temps de développement.
Utilisation en VB6 :

Code:

1
2
3
Dim R As Long
R = InputBox("Rayon de votrte sphère")
Label1 = ((4 * (4 * Atn(1)) * R ^ 3) / 3)

Utilisation en VBScript :

Code:

1
2
3
Dim R
R = InputBox("Rayon de votrte sphère")
MsgBox ((4 * (4 * Atn(1)) * R ^ 3) / 3)

Il vous est possible d’ajouter/supprimer des formules de votre choix dans le fichier

Citation:

Envoyé par FichierArray.txt

1 = 1 = 2 = 3
Nom de la formule = enoncé de la formule = OPTION VALUE = Titre ou intitulé de la ligne Select
= = =---- Fonctions mathématiques ----
= =Abs(X)=Abs(x) -> Valeur absolue
= =Atn(X)=Atn(x) -> Arctangente
= =Cos(X)=Cos(x) -> Cosinus
= =Exp(X)=Exp(x) -> Antilogarithme
= =Fix(X)=Fix(x) -> partie entière
= =Int(X)=Int(x) -> partie entière
= =Log(X)=Log(x) -> logarithme népérien
= =Rnd(X)=Rnd(x) -> nombre aléatoire
= =Sin(X)=Sin(x) -> Sinus
= =Sqr(X)=Sqr(x) -> Racine carrée
= =Tan(X)=Tan(x) -> Tangente
= = =
= = =---- Mathématiques dérivées ----
LogN=Log(X)/Log(N)=LogN(x,n)=LogN(X,N) -> Logarithme de base N
Sec=1/Cos(X)=Sec(x)=Sec(x) -> Sécante
Cosec=1/Sin(X)=Cosec(x)=Cosec(x) -> Cosécante
Cotan=1/Tan(X)=Cotan(x)=Cotan(x) -> Cotangente
Arcsin=Atn(X/Sqr(-X*X+1))=Arcsin(x)=Arcsin(x) -> Inverse Sinus
Arccos=Atn(-X/Sqr(-X*X+1))+2*Atn(1)=Arccos(x)=Arccos(x) -> Inverse Cosinus
Arcsec=Atn(X/Sqr(X*X-1))+Sgn((X)-1)*(2*Atn(1))=Arcsec(x)=Arcsec(x) -> Inverse Sécante
Arccosec=Atn(X/Sqr(X*X-1))+(Sgn(X)-1)*(2*Atn(1))=Arccosec(x)=Arccosec(x) -> Inverse Cosécante
Arccotan=Atn(X)+2*Atn(1)=Arccotan(x)=Arccotan(x) -> Inverse Cotangente
HSin=(Exp(X)-Exp(-X))/ 2=Hsin(x)=Hsin(x) -> Sinus Hyperbolique
HCos=(Exp(X)+Exp(-X))/2=HCos(x)=HCos(x) -> Cosinus hyperbolique
HTan=(Exp(X)-Exp(-X))/(Exp(X)+Exp(-X))=HTan(x)=HTan(x) -> Tangente hyperbolique
HSec=2/(Exp(X)+Exp(-X))=HSec(x)=HSec(x) -> Sécante hyperbolique
HCosec=2/(Exp(X)-Exp(-X))=HCosec(x)=HCosec(x) -> Cosécante hyperbolique
HCotan=(Exp(X)+Exp(-X))/(Exp(X)-Exp(-X))=HCotan(x)=HCotan(x) -> Cotangente hyperbolique
HArcsin=Log(X+Sqr(X*X+1))=HArcsin(x)=HArcsin(x) -> Arcsinus hyperbolique
HArccos=Log(X+Sqr(X*X-1))=HArccos(x)=HArccos(x) -> Arccosinus hyperbolique
HArctan=Log((1+X)/(1-X))/2=HArctan(x)=HArctan(x) -> Arctangente hyperbolique
HArcsec=Log((Sqr(-X*X+1)+1)/X)=HArcsec(x)=HArcsec(x) -> Arcsécante hyperbolique
HArccosec=Log((Sgn(X)*Sqr(X*X+1)+1)/X)=HArccosec(x)=HArccosec(x) -> Arccosécante hyperbolique
HArccotan=Log((X+1)/(X-1))/2=HArccotan(x)=HArccotan(x) -> Arccotangente hyperbolique
= = =
= = =---- Conversion angulaire ----
DegRad=Pi*X/180=DegRad(x)=DegRad(x) -> Degré -> Radian
RadDeg=180*X/Pi=RadDeg(x)=RadDeg(x) -> Radian -> Degré
RadGrad=200*X/Pi=RadGrad(x)=RadGrad(x) -> Radian -> Gradian
GradRad=Pi*X/200=GradRad(x)=GradRad(x) -> Gradian -> Radian
GradDeg=180*X/200=GradDeg(x)=GradDeg(x) -> Gradian -> Degré
DegGrad=200*X/180=DegGrad(x)=DegGrad(x) -> Degré -> Gradian
= = =
= = =---- Cercle/sphére ----
PériCercle=2*Pi*X=PériCercle(x)=Périmètre du cercle(R) -> Rayon
SurfaceCercle=X^2*Pi=SurfaceCercle(x)=Surface du Cercle(R) -> Rayon
SurfaceSphère=4*Pi*X^2=SurfaceSphère(x)=Surface de la sphère(R) -> Rayon
VolumeSphère=(4*Pi*X^3)/3=VolumeSphère(x)=Volume de la sphère(R) -> Rayon

Attention, l’énoncé formule est sensible aux minuscules/MAJUSCULES, le fichier doit se trouver dans le même dossier que L'HTA.

La Sub LstFormules_onmouseover m’a posé beaucoup de problèmes, elle permet de récupérer l’équivalant VB 6 de Selstart, SelLenght et SelText de la boite INPUT TYPE="text" d’Id " txtEnoncer ".

L’initialisation de StartSel est galère, lors de la construction de votre HTA, ouvrez la boite INPUT TYPE="text"" d’Id « txtDebug» par double click sur le texte Enoncé du calcul, glissez jusqu’à la liste choix de raccourcis Formules, vous pourrez évaluer le bonne valeur à donner à la variable StartSel visible à droite de la boite Résultat.

Le HTA
http://contrib-vb.developpez.com/Pro...sions/Img5.jpg

Code:

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
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
<HEAD>
  <title> Aide au calcul V2.0 </title>
	<HTA:APPLICATION
		id="CalcModule"
		applicationname="CalcModule"
		version="2"
 		MAXIMIZEBUTTON="no"
		SCROLL="no"
		BORDER = "thin"	>
 
	<SCRIPT language="VBScript" type="text/vbscript">ResizeTo 927,196: MoveTo (Screen.Width-927)/2,(Screen.Height - 196) / 2</SCRIPT>
</HEAD>
<SCRIPT language="VBScript" type="text/vbscript">
Option Explicit
 
' Déclarations utilisables dans toute la partie VBScript
Dim LaFormule()
Dim SelTexte, NbrCaract
Dim posFin, StartSel
Dim DossierDuProg 
Dim ScriptCtrl, RegEx
Const Pi = "(4*Atn(1))" 'son équivalence proche
'----------------------------------------------------------------------------------------------------------------------
Sub Window_Onload()
'initialisation
Set ScriptCtrl = CreateObject("ScriptControl")
ScriptCtrl.Language = "vbscript"
 
Set RegEx = New RegExp
RegEx.IgnoreCase = False 'distingue les lettres minuscule et MAJUSCULE
RegEx.Global = True 'la recherche s'applique à la chaîne entière
 
Dim WshShell
Set WshShell = CreateObject("WScript.Shell")
If WshShell.ExpandEnvironmentStrings("%HOMEDRIVE%") <> Left(WshShell.CurrentDirectory, 2) Then
	'DossierDuProg = Left(WshShell.CurrentDirectory, 3) & "Calculateurs\Calcul divers\" ' sur le serveur
	DossierDuProg = WshShell.CurrentDirectory & "\" ' sur clef USB
	Else
	DossierDuProg = WshShell.CurrentDirectory & "\" ' en local
End If
Set WshShell = Nothing
 
ChargeFormules
 
txtDebug.Style.display = "none": : BtRefresh.Style.display = "none" 'ne sera visible que s'il se produit une erreur
End Sub
'----------------------------------------------------------------------------------------------------------------------
Sub Window_OnUnload()
Set ScriptCtrl = Nothing
Set RegEx = Nothing
End Sub
'----------------------------------------------------------------------------------------------------------------------
Sub ChargeFormules()
 
Dim FSO, LeFichier, PourTbl
Set FSO = CreateObject("Scripting.FileSystemObject")
Set LeFichier = FSO.OpenTextFile(DossierDuProg & "FichierArray.txt",1)
PourTbl = LeFichier.ReadAll: LeFichier.Close
Set FSO = Nothing
 
Dim MeTbl, ChampS, T, U
MeTbl = split(PourTbl,vbNewLine)
Dim oOption
'vide la liste LstFormules (pour rafraichissement  Ajout/suppression dans le fichier FichierArray.txt)
For T = LstFormules.length To 0 Step -1: LstFormules.Remove(T): Next
U = 0
For T = 2 To UBound(MeTbl)
	Set oOption = window.Document.createElement("OPTION")
	ChampS = split(MeTbl(T),"=")
	If ChampS(2) = " " Then 'ligne vierge ou titre 
		If ChampS(3) = "" Then oOption.Value = "": oOption.Text = "" 'ligne vierge 
		If ChampS(3) <> "" Then oOption.Value = "": oOption.Text = ChampS(3) 'Titre ensemble de formules de la ligne Select 
	End If
	If ChampS(1) = " " And ChampS(2) <> " " Then oOption.Value = ChampS(2): oOption.Text = ChampS(3) 'Formule intrinseque 
	If ChampS(0) <> " " Then
		oOption.Value = ChampS(2): oOption.Text = ChampS(3) 'Formule dérivée 
		U = U + 1 'pour pouvoir dimensionner le tableau formules dérivées
	End If
	LstFormules.Add (oOption)
Next
Set oOption = Nothing
 
Redim LaFormule(U,2)
U = -1
For T = 2 To UBound(MeTbl)
	ChampS = split(MeTbl(T),"=")
	If ChampS(0) <> " " Then U = U + 1: LaFormule(U,0) = ChampS(0): LaFormule(U,1) = ChampS(1) 'Ligne de formule derivée
Next
 
End Sub
'----------------------------------------------------------------------------------------------------------------------
Sub LstFormules_onmouseover()
Dim Docu, SelectioneR
Set Docu = window.document
Set SelectioneR = Docu.selection.createRange()
If Docu.activeElement.Id = "txtEnoncer" Then
    SelTexte = SelectioneR.Text
    NbrCaract = Len(SelTexte)
    StartSel = 1 ' pourquoi 1  ??? Mystère ......, trouvé .........>, La valeur de StartSel depant de l'endroit dans le code ou est déclaré le conteneur TEXTAREA ou <INPUT TYPE="text"
    While SelectioneR.Move("character", -1): StartSel = StartSel + 1: Wend
    txtDebug.Value = "texte selectionné: " & SelTexte & "   " & "Nbre de caractere: " & NbrCaract & "    " & "Debut de la selection: " & StartSel
End If
Set SelectioneR = Nothing : Set Docu = Nothing
End Sub
'----------------------------------------------------------------------------------------------------------------------
Sub LstFormules_onChange()
Call CreateObject("htmlfile").ParentWindow.ClipboardData.SetData("text", LstFormules.Value)
Dim StrtxtEnoncer, StrDeb, StrFor, StrFin
StrtxtEnoncer = txtEnoncer.Value
StrFor = LstFormules.Value 'récupération de l'énoncé de la formule choisis
If SelTexte = "" Then
    'insère au niveau du curseur
    If StartSel > 1 Then StrDeb = Left(StrtxtEnoncer, StartSel - 1)
    If StartSel < Len(StrtxtEnoncer) Then StrFin = Right(StrtxtEnoncer, Len(StrtxtEnoncer) - StartSel + 1)
    If StartSel = 1 Then StrFin = StrtxtEnoncer
    Else
    'insère au niveau du curseur en incluant la sélection
    If StrFor <> "LogN(x,n)" Then
        StrFor = Replace(StrFor, "x", SelTexte)
        Else
        StrFor = Replace(StrFor, "x,n", SelTexte)
    End If
    If StartSel > 1 Then
        StrDeb = Left(StrtxtEnoncer, StartSel - 1)
        If StartSel + NbrCaract < Len(StrtxtEnoncer) Then StrFin = Right(StrtxtEnoncer, (Len(StrtxtEnoncer) - (StartSel + Len(SelTexte)) + 1))
    End If
    If StartSel = 1 Then
        If NbrCaract < Len(StrtxtEnoncer) Then StrFin = Right(StrtxtEnoncer, Len(StrtxtEnoncer) - Len(SelTexte))
    End If
End If
txtEnoncer.Value = StrDeb & StrFor & StrFin
SelTexte = "": StartSel = 0: NbrCaract = 0
End Sub
'----------------------------------------------------------------------------------------------------------------------
Sub BtGo_onClick()
txtDebug.Style.display = "none"
Dim Matches
Dim Cpt, PosDeb
Dim StrFortmater, Transf
Dim Enoncer, X, Colonne
 
StrFortmater = Trim(txtEnoncer.Value)
For Cpt = 0 To UBound(LaFormule)
    if LaFormule(Cpt, 0) = "" then exit for
	RegEx.Pattern = "\b" & LaFormule(Cpt, 0) & "\b" 'mot entier avec respect des lettres minuscules et MAJUSCULES
    Do While RegEx.Test(StrFortmater) = True
        Set Matches = RegEx.Execute(StrFortmater)
        PosDeb = Matches.Item(0).FirstIndex + 1
        X = RecupF(StrFortmater, PosDeb + Matches.Item(0).Length)
        Enoncer = Mid(StrFortmater, PosDeb, posFin - PosDeb)
        If LaFormule(Cpt, 0) <> "LogN" Then
            Transf = Replace(LaFormule(Cpt, 1), "X", X)
            Else
            If Instr(X,",") = 0 Then
				txtDebug.Value = "Nombre d'arguments ou affectation de propriété incorrects: " & Chr(34) & "Log" & Chr(34)
				txtDebug.Style.display = ""
				Exit Sub
			End If
            Colonne = Split(X, ",")
			Transf = Replace(LaFormule(Cpt, 1), "X", Colonne(0))
            Transf = Replace(Transf, "N", Colonne(1))
        End If
        Transf = "(" & Transf & ")" 'pour faire considérer à ScriptCtrl.Eval qu'il doit calculer l'ensemble de la fonction
        StrFortmater = Replace(StrFortmater, Enoncer, Transf, 1, 1, vbTextCompare)
    Loop
Next
'gérer le remplacement du literal Pi par son équivalence proche 4 * Atn(1)
StrFortmater = Replace(StrFortmater, "Pi", Pi, 1, -1, vbTextCompare)
'gérer le remplacement de la virgule séparateur décimale littéral par le séparateur décimale mathématique point
StrFortmater = Replace(StrFortmater, ",", ".", 1, -1, vbTextCompare)
txtFormater.Value = StrFortmater
 
On Error Resume Next
txtResult.Value = ""
txtResult.Value = ScriptCtrl.Eval(StrFortmater)
'__________________ petite gestion d'erreur '__________________
If ScriptCtrl.Error.Number <> 0 Then
    Err.Clear
    If chkAide.Checked = True Then txtDebug.Value = ScriptCtrl.Error.Description: txtDebug.Style.display = ""
    Else
    If txtResult.Value = "" Then
        If chkAide.Checked = True Then txtDebug.Value = "Impossible d'évaluer votre ligne de calcul": txtDebug.Style.display = ""
    End If
End If
 
Set Matches = Nothing
End Sub
'----------------------------------------------------------------------------------------------------------------------
Function RecupF(DansStr, Start)
    Dim Ov, Fr, T
    'compter les ( avec Ov, et en même temps les ), quand il y a égalité, la formule est complète, le dernier ) est égal à posFin
    For T = Start To Len(DansStr)
        If Mid(DansStr, T, 1) = "(" Then Ov = Ov + 1
        If Mid(DansStr, T, 1) = ")" Then Fr = Fr + 1
        If Ov = Fr And Ov <> 0 Then
            posFin = T + 1
            RecupF = Mid(DansStr, Start + 1, T - (Start + 1)): Exit For
        End If
    Next
End Function
'----------------------------------------------------'pour débuguer par le créateur de l'.HTA-------------------------
Sub Masque_ondblclick()
 
If txtDebug.Style.display = "" Then
	txtDebug.Style.display = "none": BtRefresh.Style.display = "none"
	Else
	txtDebug.Style.display = "": BtRefresh.Style.display = ""
End If
End Sub
'----------------------------------------------------------------------------------------------------------------------
Sub BtRefresh_onClick()
ChargeFormules
End Sub
 
</SCRIPT>
<body style="font-family:Courier New; Arial, MS Sans Serif, Verdana, serif; font-size=14px; font-weight:bold; background-color: #3D6381">
	<Div Name="Masque" Id="Masque" style="color:#FFFFFF; position:absolute; left:8px; top:20px; height:22px; width:150px"> Enoncé du calcul </Div>
	<SELECT name="LstFormules" Id="LstFormules" title="Insert ou englobe la sélection dans l'énoncé"
		style="position: absolute; left: 240px; top: 8px; height:22px; width:327px"> </SELECT>
	<Div style="color:#FFFFFF; position:absolute; left:572px; top:10px; height:22px; width:160px" > Raccourcis formules </Div>
	<INPUT TYPE="CheckBox" NAME="chkAide" Id="chkAide" title="En cas d'erreur afficher un message" CHECKED
		style="background-color: #3D6381; border-style: solid; position: absolute; left:885px; top:8px; height:21px; width:21px" >
	<INPUT TYPE="text" name="txtEnoncer" Id="txtEnoncer" Value =""  
		style="background-color: #D2FFC2; border-style: solid; position: absolute; left:4px; top:36px; height:21px; width:905px; font-family:Courier New; Arial, MS Sans Serif, Verdana, serif"> 
	<Div style="color:#FFFFFF; position:absolute; left:8px; top:60px; height:22px; width:400px" > Enoncé reformaté (détails des formules dérivées) </Div>
	<TEXTAREA name="txtFormater" Id="txtFormater" Value ="" Rows="2" COLS="40"
		style="background-color: #FFFFB3; border-style: solid; position: absolute; left:4px; top:76px; height:42px; width:905px; font-family:Courier New; Arial, MS Sans Serif, Verdana, serif"></TEXTAREA>
	<INPUT Type="button" name="BtGo" Id="BtGo" value="Go" 
		style="position: absolute; left: 5px; top: 124px; height:28px; width:41px" >
	<Div style="color:#FFFFFF; position:absolute; left:70px; top:131px; height:22px; width:56px" > Résultat </Div>
	<INPUT TYPE="text" name="txtResult" Id="txtResult" Value ="" 
		style="background-color: #FFFFFF; border-style: solid; position: absolute; left:136px; top:129px; height:21px; width:213px" >
	<INPUT TYPE="text" NAME="txtDebug" id="txtDebug" VALUE="Pour débuguer"
		style="color:#FF0000; border-style:solid; position:absolute; left:360px; top:129px;  height:21px; width:550px" > 
	<INPUT Type="button" name="BtRefresh" Id="BtRefresh" value="Actualiser liste formules" 
		style="position: absolute; left: 5px; top: 4px; height:20px; width:150px" >
</body>

Au moins un défaut :cry: (restons optimiste :aie:) , impossible de sélectionné 2 fois de suite la même formule, si quelqu'un saurait quel événement On_Quoi utiliser :calim2:.