Dépassement de capacité
Résolu
miamiaca
Messages postés
17
Date d'inscription
dimanche 5 mars 2006
Statut
Membre
Dernière intervention
22 février 2007
-
16 févr. 2007 à 21:31
Gobillot Messages postés 3140 Date d'inscription vendredi 14 mai 2004 Statut Membre Dernière intervention 11 mars 2019 - 16 mars 2007 à 00:16
Gobillot Messages postés 3140 Date d'inscription vendredi 14 mai 2004 Statut Membre Dernière intervention 11 mars 2019 - 16 mars 2007 à 00:16
A voir également:
- L'opération arithmétique a provoqué un dépassement de capacité
- Contourné dépassement de capacité - Forum Visual Basic 6
- L'opération doit utiliser une requête qui peut être mise à jour - Forum VB.NET
- Erreur d'exécution: dépassement de capacité. ✓ - Forum Visual Basic 6
- Probleme de depassement de capacite listbox - Forum VBA Office (Excel, Word ...)
- Socket operation on non-socket ✓ - Forum C
43 réponses
Gobillot
Messages postés
3140
Date d'inscription
vendredi 14 mai 2004
Statut
Membre
Dernière intervention
11 mars 2019
34
3 mars 2007 à 20:27
3 mars 2007 à 20:27
la multiplication c'est facile, la division c'est autre chose:
pour n1 et n2 de 1016 chiffres et precis = 1000, 172 ms avec des tableaux de Long et 125 ms avec des tableaux de Double.
preci = 1000
nb1 = "+6859610553647623715964088665892371829439866709240283944117," & _
"9881257041327422001125735162772203142673516307553314590384" & _
"6660055334469068596105536476237159640886658923718294398667" & _
"0992402839441179812570413274220011257351627722031426735163" & _
"0775533145903846600553344690685961055364762371596408866589" & _
"2337182943986670924028394411798125704132742200112573516277" & _
"2220314267351630755331459038466005533446906859610553647623" & _
"7115964088665892371829439866709240283944117981257041327422" & _
"0001125735162772203142673516307553314590384660055334469068" & _
"5996105536476237159640886658923718294398667092402839441179" & _
"8112570413274220011257351627722031426735163075533145903846" & _
"6000553344690685961055364762371596408866589237182943986670" & _
"9224028394411798125704132742200112674526387320324368462731" & _
"8665332569149576116644556917950611664758624725074199775893" & _
"4882830449977810340293054227081367151338522001236745263873" & _
"2003243684627318653325691495761166445569179506116647586247" & _
"2550741997758934828304499778103402930542270813671513385220" & _
"012367452638732032436846273186"
nb2 = "+7467636322858211413420378952487507706693561915417437336022," & _
"8558108410407266652454504706493231612117134305999525878380" & _
"1997265629154474676363228582114134203789524875077066935619" & _
"1554174373360228581084104072666524545047064932316121171343" & _
"0559995258783801972656291544746763632285821141342037895248" & _
"7550770669356191541743733602285810841040726665245450470649" & _
"3223161211713430599952587838019726562915447467636322858211" & _
"4113420378952487507706693561915417437336022858108410407266" & _
"6552454504706493231612117134305999525878380197265629154474" & _
"6776363228582114134203789524875077066935619154174373360228" & _
"5881084104072666524545047064932316121171343059995258783801" & _
"9772656291544746763632285821141342037895248750770669356191" & _
"5441743733602285810841040726665245551571749433261312724531" & _
"6009063598848010737672026558578647323968212413431379053598" & _
"5118717704662925428548446023968219411408376752565515717494" & _
"3332613127245316090635988480107376720265585786473239682124" & _
"1334313790535985187177046629254285484460239682194114083767" & _
"525655157174943326131272453160"
MsgBox Division(nb1, nb2)
Const param = 9
Const puis = 1000000000
Const frmt = "000000000"
Const chrz = "0"
Const sep = ","
Dim preci As Integer 'nombre de chiffres significatifs maxi
Dim pos As Integer
Private Function Division(n1 As String, n2 As String) As String
Dim a As String
Dim b As String
Dim c As String
Dim resu As String
Dim sg As String
Dim zero As String
Dim a1 As Integer
Dim a2 As Integer
Dim b1 As Integer
Dim b2 As Integer
Dim di As Integer
Dim dj As Integer
Dim i As Long
Dim j As Long
Dim k As Integer
Dim r As Integer
Dim n As Integer
Dim p As Integer
Dim puis2 As Long
Dim q As Integer
Dim v1 As Long
Dim v2 As Long
Dim x As Integer
Dim z As Integer
Dim W1() As Long
Dim W2() As Long
If Mid$(n2, 2) = chrz Then Err.Raise 11
i = InStr(n1, sep)
j = InStr(n2, sep) If i > 0 Then a1 i - 2: b1 Len(n1) - i Else a1 = Len(n1) - 1 If j > 0 Then a2 j - 2: b2 Len(n2) - j Else a2 = Len(n2) - 1 If b1 > b2 Then pos b1 Else pos b2
i = a1 + pos
j = a2 + pos If i > j Then k i Else k j di k - j: dj k - i
k = k + param - (k Mod param)
a = String$(k - i - dj, chrz) & Mid$(n1, 2, a1) & Mid$(n1, a1 + 3, b1) & String$(pos - b1 + dj, chrz)
b = String$(k - j - di, chrz) & Mid$(n2, 2, a2) & Mid$(n2, a2 + 3, b2) & String$(pos - b2 + di, chrz) If Asc(n1) Asc(n2) Then sg "+" Else sg = "-"
di = di + 1
pos = pos + dj
puis2 = puis \ 10
z = k \ param
ReDim W1(z), W2(z)
i = 1
For j = k + 1 - param To 1 Step -param
W1(i) = CLng(Mid$(a, j, param)) W2(i) CLng(Mid$(b, j, param)): i i + 1
Next
x = 0
For j = z To 1 Step -1
If W1(j) < W2(j) Then x = -1: Exit For
If W1(j) > W2(j) Then x = 1: Exit For
Next
If dj > 0 Then
If x = -1 Then
dj = dj + 1
r = 0
For j = 1 To z
v1 = W1(j)
W1(j) = (v1 Mod puis2) * 10 + r
r = v1 \ puis2
Next
End If
resu = "0," & String$(dj - 1, chrz)
p = 1: GoTo Boucle2
End If
If x = 0 Then
resu = "1" & String$(di - 1, chrz): GoTo Fin
End If
If x = -1 Then
If di > 1 Then
r = 0
For j = z To 1 Step -1
v1 = W2(j)
W2(j) = v1 \ 10 + r * puis2
r = v1 Mod 10
Next
di = di - 1
Else
r = 0
For j = 1 To z
v1 = W1(j)
W1(j) = (v1 Mod puis2) * 10 + r
r = v1 \ puis2
Next
resu = resu & "0,"
p = 1: GoTo Boucle2
End If
End If
Boucle1:
For q = 1 To di
x = 0
For j = z To 1 Step -1
If W1(j) < W2(j) Then x = -1: Exit For
If W1(j) > W2(j) Then x = 1: Exit For
Next
n = 0
While x <> -1
For i = 1 To z
v1 = W1(i) v2 W2(i) + r: r 0 If v1 < v2 Then v1 v1 + puis: r 1
W1(i) = v1 - v2
Next
x = 0
For j = z To 1 Step -1
If W1(j) < W2(j) Then x = -1: Exit For
If W1(j) > W2(j) Then x = 1: Exit For
Next
n = n + 1
Wend
If q < di Then
r = 0
For j = z To 1 Step -1
v1 = W2(j)
W2(j) = v1 \ 10 + r * puis2
r = v1 Mod 10
Next
Else
' permet d'avoir le modulo:
' j = 1
' For i = z To 1 Step -1' Mid$(a, j, param) Format$(W1(i), frmt): j j + param
' Next
End If
resu = resu & n
Next
If preci > di Then resu = resu & sep
r = 0
For j = 1 To z
v1 = W1(j)
W1(j) = (v1 Mod puis2) * 10 + r
r = v1 \ puis2
Next
Boucle2:
' If pos = 0 Then
' Modulo = a$
' Else
' Modulo = Left$(a$, k - pos) & sep & Right$(a$, pos)
' End If
dj = preci - di + p
zero = String$(k, 48)
For q = 1 To dj
x = 0
For j = z To 1 Step -1
If W1(j) < W2(j) Then x = -1: Exit For
If W1(j) > W2(j) Then x = 1: Exit For
Next
n = 0
While x <> -1
For i = 1 To z
v1 = W1(i) v2 W2(i) + r: r 0 If v1 < v2 Then v1 v1 + puis: r 1
W1(i) = v1 - v2
Next
x = 0
For j = z To 1 Step -1
If W1(j) < W2(j) Then x = -1: Exit For
If W1(j) > W2(j) Then x = 1: Exit For
Next
n = n + 1
Wend
If q < dj Then
resu = resu & n
x = 0
For j = 1 To z
If W1(j) > 0 Then x = 1: Exit For
Next
If x = 0 Then
For i = Len(resu) To di + 2 Step -1
If Mid$(resu, i, 1) <> chrz Then Exit For
Next If i di + 1 Then i di
resu = Left$(resu, i)
GoTo Fin
End If
Else
If n > 0 Then resu = resu & n
GoTo Fin
End If
r = 0
For j = 1 To z
v1 = W1(j)
W1(j) = (v1 Mod puis2) * 10 + r
r = v1 \ puis2
Next
Next
Fin:
Division = sg & resu
End Function
Daniel
pour n1 et n2 de 1016 chiffres et precis = 1000, 172 ms avec des tableaux de Long et 125 ms avec des tableaux de Double.
preci = 1000
nb1 = "+6859610553647623715964088665892371829439866709240283944117," & _
"9881257041327422001125735162772203142673516307553314590384" & _
"6660055334469068596105536476237159640886658923718294398667" & _
"0992402839441179812570413274220011257351627722031426735163" & _
"0775533145903846600553344690685961055364762371596408866589" & _
"2337182943986670924028394411798125704132742200112573516277" & _
"2220314267351630755331459038466005533446906859610553647623" & _
"7115964088665892371829439866709240283944117981257041327422" & _
"0001125735162772203142673516307553314590384660055334469068" & _
"5996105536476237159640886658923718294398667092402839441179" & _
"8112570413274220011257351627722031426735163075533145903846" & _
"6000553344690685961055364762371596408866589237182943986670" & _
"9224028394411798125704132742200112674526387320324368462731" & _
"8665332569149576116644556917950611664758624725074199775893" & _
"4882830449977810340293054227081367151338522001236745263873" & _
"2003243684627318653325691495761166445569179506116647586247" & _
"2550741997758934828304499778103402930542270813671513385220" & _
"012367452638732032436846273186"
nb2 = "+7467636322858211413420378952487507706693561915417437336022," & _
"8558108410407266652454504706493231612117134305999525878380" & _
"1997265629154474676363228582114134203789524875077066935619" & _
"1554174373360228581084104072666524545047064932316121171343" & _
"0559995258783801972656291544746763632285821141342037895248" & _
"7550770669356191541743733602285810841040726665245450470649" & _
"3223161211713430599952587838019726562915447467636322858211" & _
"4113420378952487507706693561915417437336022858108410407266" & _
"6552454504706493231612117134305999525878380197265629154474" & _
"6776363228582114134203789524875077066935619154174373360228" & _
"5881084104072666524545047064932316121171343059995258783801" & _
"9772656291544746763632285821141342037895248750770669356191" & _
"5441743733602285810841040726665245551571749433261312724531" & _
"6009063598848010737672026558578647323968212413431379053598" & _
"5118717704662925428548446023968219411408376752565515717494" & _
"3332613127245316090635988480107376720265585786473239682124" & _
"1334313790535985187177046629254285484460239682194114083767" & _
"525655157174943326131272453160"
MsgBox Division(nb1, nb2)
Const param = 9
Const puis = 1000000000
Const frmt = "000000000"
Const chrz = "0"
Const sep = ","
Dim preci As Integer 'nombre de chiffres significatifs maxi
Dim pos As Integer
Private Function Division(n1 As String, n2 As String) As String
Dim a As String
Dim b As String
Dim c As String
Dim resu As String
Dim sg As String
Dim zero As String
Dim a1 As Integer
Dim a2 As Integer
Dim b1 As Integer
Dim b2 As Integer
Dim di As Integer
Dim dj As Integer
Dim i As Long
Dim j As Long
Dim k As Integer
Dim r As Integer
Dim n As Integer
Dim p As Integer
Dim puis2 As Long
Dim q As Integer
Dim v1 As Long
Dim v2 As Long
Dim x As Integer
Dim z As Integer
Dim W1() As Long
Dim W2() As Long
If Mid$(n2, 2) = chrz Then Err.Raise 11
i = InStr(n1, sep)
j = InStr(n2, sep) If i > 0 Then a1 i - 2: b1 Len(n1) - i Else a1 = Len(n1) - 1 If j > 0 Then a2 j - 2: b2 Len(n2) - j Else a2 = Len(n2) - 1 If b1 > b2 Then pos b1 Else pos b2
i = a1 + pos
j = a2 + pos If i > j Then k i Else k j di k - j: dj k - i
k = k + param - (k Mod param)
a = String$(k - i - dj, chrz) & Mid$(n1, 2, a1) & Mid$(n1, a1 + 3, b1) & String$(pos - b1 + dj, chrz)
b = String$(k - j - di, chrz) & Mid$(n2, 2, a2) & Mid$(n2, a2 + 3, b2) & String$(pos - b2 + di, chrz) If Asc(n1) Asc(n2) Then sg "+" Else sg = "-"
di = di + 1
pos = pos + dj
puis2 = puis \ 10
z = k \ param
ReDim W1(z), W2(z)
i = 1
For j = k + 1 - param To 1 Step -param
W1(i) = CLng(Mid$(a, j, param)) W2(i) CLng(Mid$(b, j, param)): i i + 1
Next
x = 0
For j = z To 1 Step -1
If W1(j) < W2(j) Then x = -1: Exit For
If W1(j) > W2(j) Then x = 1: Exit For
Next
If dj > 0 Then
If x = -1 Then
dj = dj + 1
r = 0
For j = 1 To z
v1 = W1(j)
W1(j) = (v1 Mod puis2) * 10 + r
r = v1 \ puis2
Next
End If
resu = "0," & String$(dj - 1, chrz)
p = 1: GoTo Boucle2
End If
If x = 0 Then
resu = "1" & String$(di - 1, chrz): GoTo Fin
End If
If x = -1 Then
If di > 1 Then
r = 0
For j = z To 1 Step -1
v1 = W2(j)
W2(j) = v1 \ 10 + r * puis2
r = v1 Mod 10
Next
di = di - 1
Else
r = 0
For j = 1 To z
v1 = W1(j)
W1(j) = (v1 Mod puis2) * 10 + r
r = v1 \ puis2
Next
resu = resu & "0,"
p = 1: GoTo Boucle2
End If
End If
Boucle1:
For q = 1 To di
x = 0
For j = z To 1 Step -1
If W1(j) < W2(j) Then x = -1: Exit For
If W1(j) > W2(j) Then x = 1: Exit For
Next
n = 0
While x <> -1
For i = 1 To z
v1 = W1(i) v2 W2(i) + r: r 0 If v1 < v2 Then v1 v1 + puis: r 1
W1(i) = v1 - v2
Next
x = 0
For j = z To 1 Step -1
If W1(j) < W2(j) Then x = -1: Exit For
If W1(j) > W2(j) Then x = 1: Exit For
Next
n = n + 1
Wend
If q < di Then
r = 0
For j = z To 1 Step -1
v1 = W2(j)
W2(j) = v1 \ 10 + r * puis2
r = v1 Mod 10
Next
Else
' permet d'avoir le modulo:
' j = 1
' For i = z To 1 Step -1' Mid$(a, j, param) Format$(W1(i), frmt): j j + param
' Next
End If
resu = resu & n
Next
If preci > di Then resu = resu & sep
r = 0
For j = 1 To z
v1 = W1(j)
W1(j) = (v1 Mod puis2) * 10 + r
r = v1 \ puis2
Next
Boucle2:
' If pos = 0 Then
' Modulo = a$
' Else
' Modulo = Left$(a$, k - pos) & sep & Right$(a$, pos)
' End If
dj = preci - di + p
zero = String$(k, 48)
For q = 1 To dj
x = 0
For j = z To 1 Step -1
If W1(j) < W2(j) Then x = -1: Exit For
If W1(j) > W2(j) Then x = 1: Exit For
Next
n = 0
While x <> -1
For i = 1 To z
v1 = W1(i) v2 W2(i) + r: r 0 If v1 < v2 Then v1 v1 + puis: r 1
W1(i) = v1 - v2
Next
x = 0
For j = z To 1 Step -1
If W1(j) < W2(j) Then x = -1: Exit For
If W1(j) > W2(j) Then x = 1: Exit For
Next
n = n + 1
Wend
If q < dj Then
resu = resu & n
x = 0
For j = 1 To z
If W1(j) > 0 Then x = 1: Exit For
Next
If x = 0 Then
For i = Len(resu) To di + 2 Step -1
If Mid$(resu, i, 1) <> chrz Then Exit For
Next If i di + 1 Then i di
resu = Left$(resu, i)
GoTo Fin
End If
Else
If n > 0 Then resu = resu & n
GoTo Fin
End If
r = 0
For j = 1 To z
v1 = W1(j)
W1(j) = (v1 Mod puis2) * 10 + r
r = v1 \ puis2
Next
Next
Fin:
Division = sg & resu
End Function
Daniel
Gobillot
Messages postés
3140
Date d'inscription
vendredi 14 mai 2004
Statut
Membre
Dernière intervention
11 mars 2019
34
8 mars 2007 à 23:57
8 mars 2007 à 23:57
pas mal de modifications depuis:
j'ai maintenant 2 modules ( a et b)
le premier travaille en Long, le second en Double
bien que le Double est plus lent, je peux mettre plus de chiffres, 7 pour la multiplication au lieu de 4, et 14 pour les autres opérations au lieu de 9, donc le Double devient plus rapide.
la Fonction Arrondi permet de tronquer au nombre de chiffres significatifs (sauf si Tronq = False)
elle est utilisée par toutes les opérations sauf la division (qui elle calcule un chiffre en plus pour permettre l'arrondi)
ce qui permet d'avoir des résultats "exacts"
retrouver le dividende en multipliant par le quotient: (20 / 9) * 9 = 20
l'inverse de l'inverse doit donner le même nombre: (1 / (1 / 9) --> 9
la Division donne en prime le Modulo (en réel) et le Modulo donne en prime le quotient entier.
je donne tout le module b plus quelques publics du module a
j'espère avoir rien oublié
il y a encore pas mal de choses à revoir,
par exemple la division qui donne parfois beaucoup trop de zéro aprés la virgule
Option Explicit
Const chrz = "0"
Const sep = ","
Dim parm As Integer
Dim puis As Double
Dim frmt As String
Dim s1 As Byte
Dim s2 As Byte
Dim a1 As Integer
Dim a2 As Integer
Dim b1 As Integer
Dim b2 As Integer
Dim k As Integer
Public preci As Integer
Public pos As Integer
Public Modulo As String
Public Quotient As String
Public Tronq As Boolean
Public Function bAddition(n1 As String, n2 As String) As String
Dim a As String
Dim b As String
Dim i As Integer
Dim j As Integer
Dim x As Integer
parm = 14
puis = 10 ^ parm
frmt = String(parm, chrz)
i = InStr(n1, sep)
j = InStr(n2, sep) If i > 0 Then a1 i - 2: b1 Len(n1) - i Else a1 = Len(n1) - 1: b1 = 0 If j > 0 Then a2 j - 2: b2 Len(n2) - j Else a2 = Len(n2) - 1: b2 = 0 If b1 > b2 Then pos b1 Else pos b2
i = a1 + pos
j = a2 + pos If i > j Then k i Else k j
k = k + parm - (k Mod parm)
a = String$(k - i, chrz) & Mid$(n1, 2, a1) & Mid$(n1, a1 + 3, b1) & String$(pos - b1, chrz)
b = String$(k - j, chrz) & Mid$(n2, 2, a2) & Mid$(n2, a2 + 3, b2) & String$(pos - b2, chrz) s1 Asc(n1): s2 Asc(n2)
If s1 <> s2 Then
x = StrComp(a, b, vbBinaryCompare)
Select Case x
Case 1: bAddition = bSbb(a, b, s1)
Case 0: bAddition = "+0"
Case -1: bAddition = bSbb(b, a, s2)
End Select
Exit Function
End If
bAddition = bAdd(a, b, s1)
End Function
Public Function bSoustraction(n1 As String, n2 As String) As String
Dim a As String
Dim b As String
Dim i As Integer
Dim j As Integer
Dim x As Integer
parm = 14
puis = 10 ^ parm
frmt = String(parm, chrz)
i = InStr(n1, sep)
j = InStr(n2, sep) If i > 0 Then a1 i - 2: b1 Len(n1) - i Else a1 = Len(n1) - 1: b1 = 0 If j > 0 Then a2 j - 2: b2 Len(n2) - j Else a2 = Len(n2) - 1: b2 = 0 If b1 > b2 Then pos b1 Else pos b2
i = a1 + pos
j = a2 + pos If i > j Then k i Else k j
k = k + parm - (k Mod parm)
a = String$(k - i, chrz) & Mid$(n1, 2, a1) & Mid$(n1, a1 + 3, b1) & String$(pos - b1, chrz)
b = String$(k - j, chrz) & Mid$(n2, 2, a2) & Mid$(n2, a2 + 3, b2) & String$(pos - b2, chrz) s1 Asc(n1): s2 Asc(n2)
If s1 <> s2 Then
bSoustraction = bAdd(a, b, s1)
Exit Function
End If If s1 43 Then s2 45 Else s2 = 43
x = StrComp(a, b, vbBinaryCompare)
Select Case x
Case 1: bSoustraction = bSbb(a, b, s1)
Case 0: bSoustraction = "+0"
Case -1: bSoustraction = bSbb(b, a, s2)
End Select
End Function
Private Function bAdd(n1 As String, n2 As String, sg As Byte) As String
Dim c As String
Dim i As Integer
Dim j As Integer
Dim x As Integer
Dim r As Long
Dim t As Double
parm = 14
puis = 10 ^ parm
frmt = String(parm, chrz)
k = Len(n1)
c = String$(k, chrz)
For i = k + 1 - parm To 1 Step -parm
t = CDbl(Mid$(n1, i, parm)) + CDbl(Mid$(n2, i, parm)) + r
r = 0: If t >= puis Then r = 1: t = t - puis
Mid$(c, i, parm) = Format$(t, frmt)
Next
bAdd = Arrondi(c$, Chr$(sg))
End Function
Private Function bSbb(n1 As String, n2 As String, sg As Byte) As String
Dim c As String
Dim i As Integer
Dim j As Integer
Dim x As Integer
Dim r As Long
Dim t As Double
Dim v1 As Double
Dim v2 As Double
k = Len(n1)
c = String$(k, chrz)
For i = k + 1 - parm To 1 Step -parm
v1 = CDbl(Mid$(n1, i, parm)) v2 CDbl(Mid$(n2, i, parm)) + r: r 0 If v1 < v2 Then v1 v1 + puis: r 1
t = v1 - v2
Mid$(c, i, parm) = Format$(t, frmt)
Next
bSbb = Arrondi(c$, Chr$(sg))
End Function
Public Function bMultiplication(n1 As String, n2 As String) As String
Dim a As String
Dim b As String
Dim d As String
Dim sg As String
Dim i As Long
Dim j As Long
Dim ka As Integer
Dim kb As Integer
Dim x As Integer
Dim y As Integer
Dim z As Integer
Dim r As Long
Dim tt As Double
Dim v1 As Double
Dim v2 As Double
Dim W1() As Double
Dim W2() As Double
parm = 7
puis = 10 ^ parm
frmt = String(parm, chrz)
i = InStr(n1, sep)
j = InStr(n2, sep) If i > 0 Then a1 i - 2: b1 Len(n1) - i Else a1 = Len(n1) - 1: b1 = 0 If j > 0 Then a2 j - 2: b2 Len(n2) - j Else a2 = Len(n2) - 1: b2 = 0
pos = b1 + b2 If Asc(n1) Asc(n2) Then sg "+" Else sg = "-"
i a1 + b1: x parm - (i Mod parm): If x = parm Then x = 0 j a2 + b2: y parm - (j Mod parm): If y = parm Then y = 0
a = String$(y, chrz) & Mid$(n2, 2, a2) & Mid$(n2, a2 + 3, b2)
b = String$(x, chrz) & Mid$(n1, 2, a1) & Mid$(n1, a1 + 3, b1) ka y + j: kb x + i
x kb \ parm: k ka + kb: z = k \ parm
ReDim W1(x), W2(z)
i = 1
For j = kb + 1 - parm To 1 Step -parm W1(i) CDbl(Mid$(b, j, parm)): i i + 1
Next
y = 0
For i = ka + 1 - parm To 1 Step -parm
v1 = CDbl(Mid$(a, i, parm))
r = 0
For j = 1 To x
tt = W1(j) * v1 + W2(j + y) + r
r = Int(tt / puis)
W2(j + y) = tt - r * puis
Next
W2(j + y) = r
y = y + 1
Next
d$ = String(k, chrz)
j = 1
For i = z To 1 Step -1 Mid$(d$, j, parm) Format$(W2(i), frmt): j j + parm
Next
bMultiplication = Arrondi(d$, sg)
End Function
Public Function bDivision(n1 As String, n2 As String) As String
Dim a As String
Dim b As String
Dim c As String
Dim resu As String
Dim sg As String
Dim di As Integer
Dim dj As Integer
Dim i As Long
Dim j As Long
Dim r As Integer
Dim n As Integer
Dim p As Integer
Dim puis2 As Double
Dim q As Integer
Dim v1 As Double
Dim v2 As Double
Dim x As Integer
Dim z As Integer
Dim W1() As Double
Dim W2() As Double
If Mid$(n2, 2) = chrz Then Err.Raise 11
parm = 14
puis = 10 ^ parm
frmt = String(parm, chrz)
puis2 = puis / 10
i = InStr(n1, sep)
j = InStr(n2, sep) If i > 0 Then a1 i - 2: b1 Len(n1) - i Else a1 = Len(n1) - 1: b1 = 0 If j > 0 Then a2 j - 2: b2 Len(n2) - j Else a2 = Len(n2) - 1: b2 = 0 If b1 > b2 Then pos b1 Else pos b2
i = a1 + pos
j = a2 + pos If i > j Then k i Else k j di k - j: dj k - i
k = k + parm - (k Mod parm)
a = String$(k - i - dj, chrz) & Mid$(n1, 2, a1) & Mid$(n1, a1 + 3, b1) & String$(pos - b1 + dj, chrz)
b = String$(k - j - di, chrz) & Mid$(n2, 2, a2) & Mid$(n2, a2 + 3, b2) & String$(pos - b2 + di, chrz) If Asc(n1) Asc(n2) Then sg "+" Else sg = "-"
di = di + 1
pos = pos + dj
z = k \ parm
ReDim W1(z), W2(z) ' et W3(z)
i = 1
For j = k + 1 - parm To 1 Step -parm
W1(i) = CDbl(Mid$(a, j, parm)) W2(i) CDbl(Mid$(b, j, parm)): i i + 1
Next
' x = StrComp(a, b, vbBinaryCompare)
x = 0
For j = z To 1 Step -1
If W1(j) < W2(j) Then x = -1: Exit For
If W1(j) > W2(j) Then x = 1: Exit For
Next
If dj > 0 Then
If x = -1 Then
dj = dj + 1
' a$ = Mid$(a$, 2) & "0"
r = 0
For j = 1 To z
v1 = W1(j)
v2 = Int(v1 / puis2)
W1(j) = (v1 - v2 * puis2) * 10 + r
r = v2
Next
End If
resu = "0," & String$(dj - 1, chrz)
p = 1: GoTo Boucle2
End If
If x = 0 Then
resu = "1" & String$(di - 1, chrz): GoTo Fin
End If
If x = -1 Then
If di > 1 Then
' b$ = "0" & Left$(b$, k - 1)
r = 0
For j = z To 1 Step -1
v1 = W2(j)
v2 = Int(v1 / 10)
W2(j) = v2 + r * puis2
r = v1 - v2 * 10
Next
di = di - 1
Else
' a$ = Mid$(a$, 2) & "0"
r = 0
For j = 1 To z
v1 = W1(j)
v2 = Int(v1 / puis2)
W1(j) = (v1 - v2 * puis2) * 10 + r
r = v2
Next
resu = resu & "0,"
p = 1: GoTo Boucle2
End If
End If
Boucle1:
For q = 1 To di
x = 0
For j = z To 1 Step -1
If W1(j) < W2(j) Then x = -1: Exit For
If W1(j) > W2(j) Then x = 1: Exit For
Next
n = 0
While x <> -1
For i = 1 To z
v1 = W1(i) v2 W2(i) + r: r 0 If v1 < v2 Then v1 v1 + puis: r 1
W1(i) = v1 - v2
Next
x = 0
For j = z To 1 Step -1
If W1(j) < W2(j) Then x = -1: Exit For
If W1(j) > W2(j) Then x = 1: Exit For
Next
n = n + 1
Wend
If q < di Then
' b$ = "0" & Left$(b$, k - 1)
r = 0
For j = z To 1 Step -1
v1 = W2(j)
v2 = Int(v1 / 10)
W2(j) = v2 + r * puis2
r = v1 - v2 * 10
Next
End If
resu = resu & n
Next
If preci + 1 > di Then resu = resu & sep
j = 1
For i = z To 1 Step -1 Mid$(a$, j, parm) Format$(W1(i), frmt): j j + parm
Next
' a$ = Mid$(a$, 2) & "0"
r = 0
For j = 1 To z
v1 = W1(j)
v2 = Int(v1 / puis2)
W1(j) = (v1 - v2 * puis2) * 10 + r
r = v2
Next
Boucle2:
If pos = 0 Then
Modulo = a$
Else
Modulo = Left$(a$, k - pos) & sep & Right$(a$, pos)
End If
dj = preci + 1 - di + p
For q = 1 To dj
' x = StrComp(a, b, vbBinaryCompare)
x = 0
For j = z To 1 Step -1
If W1(j) < W2(j) Then x = -1: Exit For
If W1(j) > W2(j) Then x = 1: Exit For
Next
n = 0
While x <> -1
For i = 1 To z
v1 = W1(i) v2 W2(i) + r: r 0 If v1 < v2 Then v1 v1 + puis: r 1
W1(i) = v1 - v2
Next
x = 0
For j = z To 1 Step -1
If W1(j) < W2(j) Then x = -1: Exit For
If W1(j) > W2(j) Then x = 1: Exit For
Next
n = n + 1
Wend
If q < dj Then
resu = resu & n
x = 0
For j = 1 To z
If W1(j) > 0 Then x = 1: Exit For
Next
If x = 0 Then
For i = Len(resu) To di + 2 Step -1
If Mid$(resu, i, 1) <> chrz Then Exit For
Next If i di + 1 Then i di
resu = Left$(resu, i)
GoTo Fin
End If
Else
If n > 0 Then resu = resu & n
GoTo Fin
End If
' a$ = Mid$(a$, 2) & "0"
r = 0
For j = 1 To z
v1 = W1(j)
v2 = Int(v1 / puis2)
W1(j) = (v1 - v2 * puis2) * 10 + r
r = v2
Next
Next
Fin:
bDivision = sg & resu
End Function
Public Function bModulo(n1 As String, n2 As String) As String
Dim a As String
Dim b As String
Dim c As String
Dim resu As String
Dim sg As String
Dim di As Integer
Dim dj As Integer
Dim i As Long
Dim j As Long
Dim r As Integer
Dim n As Integer
Dim p As Integer
Dim puis2 As Double
Dim q As Integer
Dim v1 As Double
Dim v2 As Double
Dim x As Integer
Dim z As Integer
Dim W1() As Double
Dim W2() As Double
If Mid$(n2, 2) = chrz Then Err.Raise 11
parm = 14
puis = 10 ^ parm
frmt = String(parm, chrz)
puis2 = puis / 10
i = InStr(n1, sep)
j = InStr(n2, sep) If i > 0 Then a1 i - 2: b1 Len(n1) - i Else a1 = Len(n1) - 1: b1 = 0 If j > 0 Then a2 j - 2: b2 Len(n2) - j Else a2 = Len(n2) - 1: b2 = 0 If b1 > b2 Then pos b1 Else pos b2
i = a1 + pos
j = a2 + pos If i > j Then k i Else k j di k - j: dj k - i
k = k + parm - (k Mod parm)
a = String$(k - i - dj, chrz) & Mid$(n1, 2, a1) & Mid$(n1, a1 + 3, b1) & String$(pos - b1 + dj, chrz)
b = String$(k - j - di, chrz) & Mid$(n2, 2, a2) & Mid$(n2, a2 + 3, b2) & String$(pos - b2 + di, chrz) If Asc(n1) Asc(n2) Then sg "+" Else sg = "-"
di = di + 1
pos = pos + dj
z = k \ parm
ReDim W1(z), W2(z) ' et W3(z)
i = 1
For j = k + 1 - parm To 1 Step -parm
W1(i) = CDbl(Mid$(a, j, parm)) W2(i) CDbl(Mid$(b, j, parm)): i i + 1
Next
' x = StrComp(a, b, vbBinaryCompare)
x = 0
For j = z To 1 Step -1
If W1(j) < W2(j) Then x = -1: Exit For
If W1(j) > W2(j) Then x = 1: Exit For
Next
If dj > 0 Then
If x = -1 Then
dj = dj + 1
' a$ = Mid$(a$, 2) & "0"
r = 0
For j = 1 To z
v1 = W1(j)
v2 = Int(v1 / puis2)
W1(j) = (v1 - v2 * puis2) * 10 + r
r = v2
Next
End If
resu = "0": GoTo Fin
End If
If x = 0 Then
resu = "1" & String$(di - 1, chrz): GoTo Fin
End If
If x = -1 Then
If di > 1 Then
' b$ = "0" & Left$(b$, k - 1)
r = 0
For j = z To 1 Step -1
v1 = W2(j)
v2 = Int(v1 / 10)
W2(j) = v2 + r * puis2
r = v1 - v2 * 10
Next
di = di - 1
Else
' a$ = Mid$(a$, 2) & "0"
r = 0
For j = 1 To z
v1 = W1(j)
v2 = Int(v1 / puis2)
W1(j) = (v1 - v2 * puis2) * 10 + r
r = v2
Next
resu = resu & "0": GoTo Fin
End If
End If
Boucle1:
For q = 1 To di
x = 0
For j = z To 1 Step -1
If W1(j) < W2(j) Then x = -1: Exit For
If W1(j) > W2(j) Then x = 1: Exit For
Next
n = 0
While x <> -1
For i = 1 To z
v1 = W1(i) v2 W2(i) + r: r 0 If v1 < v2 Then v1 v1 + puis: r 1
W1(i) = v1 - v2
Next
x = 0
For j = z To 1 Step -1
If W1(j) < W2(j) Then x = -1: Exit For
If W1(j) > W2(j) Then x = 1: Exit For
Next
n = n + 1
Wend
If q < di Then
' b$ = "0" & Left$(b$, k - 1)
r = 0
For j = z To 1 Step -1
v1 = W2(j)
v2 = Int(v1 / 10)
W2(j) = v2 + r * puis2
r = v1 - v2 * 10
Next
End If
resu = resu & n
Next
j = 1
For i = z To 1 Step -1 Mid$(a$, j, parm) Format$(W1(i), frmt): j j + parm
Next
Fin:
Quotient = sg & resu
sg = Left$(n1, 1)
bModulo = Arrondi(a$, sg)
End Function
Private Function Arrondi(a As String, sg As String) As String
Dim i As Integer
Dim j As Integer
Dim x As Integer
Dim r As Long
Dim t As Double
Dim z As Integer
x = k + 1 - pos
' suppression des zéros devant
For i = 1 To x - 2
If Mid$(a$, i, 1) <> chrz Then Exit For
Next
' suppression des zéros derrière
For j = k To x Step -1
If Mid$(a$, j, 1) <> chrz Then Exit For
Next
a1 = x - i
b1 = j + 1 - x
If Tronq Then b2 preci - a1: If b2 < 0 Then b2 0
If b2 < b1 Then
If Mid$(a$, x + b2, 1) > "4" Then
z% = x + b2 - 1 j z% Mod parm: If j 0 Then j = parm
j = z% - j + 1
r = 10 ^ ((k - z%) Mod parm)
While r > 0
t = CDbl(Mid$(a$, j, parm)) + r
r = 0 If t >puis Then r 1: t = t - puis
Mid$(a$, j, parm) = Format$(t, frmt)
j = j - parm
Wend
End If If Mid$(a$, i - 1, 1) <> chrz Then i i - 1: a1 a1 + 1
For j = x + b2 - 1 To x Step -1
If Mid$(a$, j, 1) <> chrz Then Exit For
Next
b1 = j + 1 - x
End If
End If
Arrondi = sg & Mid$(a$, i, a1)
If b1 > 0 Then Arrondi = Arrondi & sep & Mid$(a$, x, b1)
End Function
Daniel
j'ai maintenant 2 modules ( a et b)
le premier travaille en Long, le second en Double
bien que le Double est plus lent, je peux mettre plus de chiffres, 7 pour la multiplication au lieu de 4, et 14 pour les autres opérations au lieu de 9, donc le Double devient plus rapide.
la Fonction Arrondi permet de tronquer au nombre de chiffres significatifs (sauf si Tronq = False)
elle est utilisée par toutes les opérations sauf la division (qui elle calcule un chiffre en plus pour permettre l'arrondi)
ce qui permet d'avoir des résultats "exacts"
retrouver le dividende en multipliant par le quotient: (20 / 9) * 9 = 20
l'inverse de l'inverse doit donner le même nombre: (1 / (1 / 9) --> 9
la Division donne en prime le Modulo (en réel) et le Modulo donne en prime le quotient entier.
je donne tout le module b plus quelques publics du module a
j'espère avoir rien oublié
il y a encore pas mal de choses à revoir,
par exemple la division qui donne parfois beaucoup trop de zéro aprés la virgule
Option Explicit
Const chrz = "0"
Const sep = ","
Dim parm As Integer
Dim puis As Double
Dim frmt As String
Dim s1 As Byte
Dim s2 As Byte
Dim a1 As Integer
Dim a2 As Integer
Dim b1 As Integer
Dim b2 As Integer
Dim k As Integer
Public preci As Integer
Public pos As Integer
Public Modulo As String
Public Quotient As String
Public Tronq As Boolean
Public Function bAddition(n1 As String, n2 As String) As String
Dim a As String
Dim b As String
Dim i As Integer
Dim j As Integer
Dim x As Integer
parm = 14
puis = 10 ^ parm
frmt = String(parm, chrz)
i = InStr(n1, sep)
j = InStr(n2, sep) If i > 0 Then a1 i - 2: b1 Len(n1) - i Else a1 = Len(n1) - 1: b1 = 0 If j > 0 Then a2 j - 2: b2 Len(n2) - j Else a2 = Len(n2) - 1: b2 = 0 If b1 > b2 Then pos b1 Else pos b2
i = a1 + pos
j = a2 + pos If i > j Then k i Else k j
k = k + parm - (k Mod parm)
a = String$(k - i, chrz) & Mid$(n1, 2, a1) & Mid$(n1, a1 + 3, b1) & String$(pos - b1, chrz)
b = String$(k - j, chrz) & Mid$(n2, 2, a2) & Mid$(n2, a2 + 3, b2) & String$(pos - b2, chrz) s1 Asc(n1): s2 Asc(n2)
If s1 <> s2 Then
x = StrComp(a, b, vbBinaryCompare)
Select Case x
Case 1: bAddition = bSbb(a, b, s1)
Case 0: bAddition = "+0"
Case -1: bAddition = bSbb(b, a, s2)
End Select
Exit Function
End If
bAddition = bAdd(a, b, s1)
End Function
Public Function bSoustraction(n1 As String, n2 As String) As String
Dim a As String
Dim b As String
Dim i As Integer
Dim j As Integer
Dim x As Integer
parm = 14
puis = 10 ^ parm
frmt = String(parm, chrz)
i = InStr(n1, sep)
j = InStr(n2, sep) If i > 0 Then a1 i - 2: b1 Len(n1) - i Else a1 = Len(n1) - 1: b1 = 0 If j > 0 Then a2 j - 2: b2 Len(n2) - j Else a2 = Len(n2) - 1: b2 = 0 If b1 > b2 Then pos b1 Else pos b2
i = a1 + pos
j = a2 + pos If i > j Then k i Else k j
k = k + parm - (k Mod parm)
a = String$(k - i, chrz) & Mid$(n1, 2, a1) & Mid$(n1, a1 + 3, b1) & String$(pos - b1, chrz)
b = String$(k - j, chrz) & Mid$(n2, 2, a2) & Mid$(n2, a2 + 3, b2) & String$(pos - b2, chrz) s1 Asc(n1): s2 Asc(n2)
If s1 <> s2 Then
bSoustraction = bAdd(a, b, s1)
Exit Function
End If If s1 43 Then s2 45 Else s2 = 43
x = StrComp(a, b, vbBinaryCompare)
Select Case x
Case 1: bSoustraction = bSbb(a, b, s1)
Case 0: bSoustraction = "+0"
Case -1: bSoustraction = bSbb(b, a, s2)
End Select
End Function
Private Function bAdd(n1 As String, n2 As String, sg As Byte) As String
Dim c As String
Dim i As Integer
Dim j As Integer
Dim x As Integer
Dim r As Long
Dim t As Double
parm = 14
puis = 10 ^ parm
frmt = String(parm, chrz)
k = Len(n1)
c = String$(k, chrz)
For i = k + 1 - parm To 1 Step -parm
t = CDbl(Mid$(n1, i, parm)) + CDbl(Mid$(n2, i, parm)) + r
r = 0: If t >= puis Then r = 1: t = t - puis
Mid$(c, i, parm) = Format$(t, frmt)
Next
bAdd = Arrondi(c$, Chr$(sg))
End Function
Private Function bSbb(n1 As String, n2 As String, sg As Byte) As String
Dim c As String
Dim i As Integer
Dim j As Integer
Dim x As Integer
Dim r As Long
Dim t As Double
Dim v1 As Double
Dim v2 As Double
k = Len(n1)
c = String$(k, chrz)
For i = k + 1 - parm To 1 Step -parm
v1 = CDbl(Mid$(n1, i, parm)) v2 CDbl(Mid$(n2, i, parm)) + r: r 0 If v1 < v2 Then v1 v1 + puis: r 1
t = v1 - v2
Mid$(c, i, parm) = Format$(t, frmt)
Next
bSbb = Arrondi(c$, Chr$(sg))
End Function
Public Function bMultiplication(n1 As String, n2 As String) As String
Dim a As String
Dim b As String
Dim d As String
Dim sg As String
Dim i As Long
Dim j As Long
Dim ka As Integer
Dim kb As Integer
Dim x As Integer
Dim y As Integer
Dim z As Integer
Dim r As Long
Dim tt As Double
Dim v1 As Double
Dim v2 As Double
Dim W1() As Double
Dim W2() As Double
parm = 7
puis = 10 ^ parm
frmt = String(parm, chrz)
i = InStr(n1, sep)
j = InStr(n2, sep) If i > 0 Then a1 i - 2: b1 Len(n1) - i Else a1 = Len(n1) - 1: b1 = 0 If j > 0 Then a2 j - 2: b2 Len(n2) - j Else a2 = Len(n2) - 1: b2 = 0
pos = b1 + b2 If Asc(n1) Asc(n2) Then sg "+" Else sg = "-"
i a1 + b1: x parm - (i Mod parm): If x = parm Then x = 0 j a2 + b2: y parm - (j Mod parm): If y = parm Then y = 0
a = String$(y, chrz) & Mid$(n2, 2, a2) & Mid$(n2, a2 + 3, b2)
b = String$(x, chrz) & Mid$(n1, 2, a1) & Mid$(n1, a1 + 3, b1) ka y + j: kb x + i
x kb \ parm: k ka + kb: z = k \ parm
ReDim W1(x), W2(z)
i = 1
For j = kb + 1 - parm To 1 Step -parm W1(i) CDbl(Mid$(b, j, parm)): i i + 1
Next
y = 0
For i = ka + 1 - parm To 1 Step -parm
v1 = CDbl(Mid$(a, i, parm))
r = 0
For j = 1 To x
tt = W1(j) * v1 + W2(j + y) + r
r = Int(tt / puis)
W2(j + y) = tt - r * puis
Next
W2(j + y) = r
y = y + 1
Next
d$ = String(k, chrz)
j = 1
For i = z To 1 Step -1 Mid$(d$, j, parm) Format$(W2(i), frmt): j j + parm
Next
bMultiplication = Arrondi(d$, sg)
End Function
Public Function bDivision(n1 As String, n2 As String) As String
Dim a As String
Dim b As String
Dim c As String
Dim resu As String
Dim sg As String
Dim di As Integer
Dim dj As Integer
Dim i As Long
Dim j As Long
Dim r As Integer
Dim n As Integer
Dim p As Integer
Dim puis2 As Double
Dim q As Integer
Dim v1 As Double
Dim v2 As Double
Dim x As Integer
Dim z As Integer
Dim W1() As Double
Dim W2() As Double
If Mid$(n2, 2) = chrz Then Err.Raise 11
parm = 14
puis = 10 ^ parm
frmt = String(parm, chrz)
puis2 = puis / 10
i = InStr(n1, sep)
j = InStr(n2, sep) If i > 0 Then a1 i - 2: b1 Len(n1) - i Else a1 = Len(n1) - 1: b1 = 0 If j > 0 Then a2 j - 2: b2 Len(n2) - j Else a2 = Len(n2) - 1: b2 = 0 If b1 > b2 Then pos b1 Else pos b2
i = a1 + pos
j = a2 + pos If i > j Then k i Else k j di k - j: dj k - i
k = k + parm - (k Mod parm)
a = String$(k - i - dj, chrz) & Mid$(n1, 2, a1) & Mid$(n1, a1 + 3, b1) & String$(pos - b1 + dj, chrz)
b = String$(k - j - di, chrz) & Mid$(n2, 2, a2) & Mid$(n2, a2 + 3, b2) & String$(pos - b2 + di, chrz) If Asc(n1) Asc(n2) Then sg "+" Else sg = "-"
di = di + 1
pos = pos + dj
z = k \ parm
ReDim W1(z), W2(z) ' et W3(z)
i = 1
For j = k + 1 - parm To 1 Step -parm
W1(i) = CDbl(Mid$(a, j, parm)) W2(i) CDbl(Mid$(b, j, parm)): i i + 1
Next
' x = StrComp(a, b, vbBinaryCompare)
x = 0
For j = z To 1 Step -1
If W1(j) < W2(j) Then x = -1: Exit For
If W1(j) > W2(j) Then x = 1: Exit For
Next
If dj > 0 Then
If x = -1 Then
dj = dj + 1
' a$ = Mid$(a$, 2) & "0"
r = 0
For j = 1 To z
v1 = W1(j)
v2 = Int(v1 / puis2)
W1(j) = (v1 - v2 * puis2) * 10 + r
r = v2
Next
End If
resu = "0," & String$(dj - 1, chrz)
p = 1: GoTo Boucle2
End If
If x = 0 Then
resu = "1" & String$(di - 1, chrz): GoTo Fin
End If
If x = -1 Then
If di > 1 Then
' b$ = "0" & Left$(b$, k - 1)
r = 0
For j = z To 1 Step -1
v1 = W2(j)
v2 = Int(v1 / 10)
W2(j) = v2 + r * puis2
r = v1 - v2 * 10
Next
di = di - 1
Else
' a$ = Mid$(a$, 2) & "0"
r = 0
For j = 1 To z
v1 = W1(j)
v2 = Int(v1 / puis2)
W1(j) = (v1 - v2 * puis2) * 10 + r
r = v2
Next
resu = resu & "0,"
p = 1: GoTo Boucle2
End If
End If
Boucle1:
For q = 1 To di
x = 0
For j = z To 1 Step -1
If W1(j) < W2(j) Then x = -1: Exit For
If W1(j) > W2(j) Then x = 1: Exit For
Next
n = 0
While x <> -1
For i = 1 To z
v1 = W1(i) v2 W2(i) + r: r 0 If v1 < v2 Then v1 v1 + puis: r 1
W1(i) = v1 - v2
Next
x = 0
For j = z To 1 Step -1
If W1(j) < W2(j) Then x = -1: Exit For
If W1(j) > W2(j) Then x = 1: Exit For
Next
n = n + 1
Wend
If q < di Then
' b$ = "0" & Left$(b$, k - 1)
r = 0
For j = z To 1 Step -1
v1 = W2(j)
v2 = Int(v1 / 10)
W2(j) = v2 + r * puis2
r = v1 - v2 * 10
Next
End If
resu = resu & n
Next
If preci + 1 > di Then resu = resu & sep
j = 1
For i = z To 1 Step -1 Mid$(a$, j, parm) Format$(W1(i), frmt): j j + parm
Next
' a$ = Mid$(a$, 2) & "0"
r = 0
For j = 1 To z
v1 = W1(j)
v2 = Int(v1 / puis2)
W1(j) = (v1 - v2 * puis2) * 10 + r
r = v2
Next
Boucle2:
If pos = 0 Then
Modulo = a$
Else
Modulo = Left$(a$, k - pos) & sep & Right$(a$, pos)
End If
dj = preci + 1 - di + p
For q = 1 To dj
' x = StrComp(a, b, vbBinaryCompare)
x = 0
For j = z To 1 Step -1
If W1(j) < W2(j) Then x = -1: Exit For
If W1(j) > W2(j) Then x = 1: Exit For
Next
n = 0
While x <> -1
For i = 1 To z
v1 = W1(i) v2 W2(i) + r: r 0 If v1 < v2 Then v1 v1 + puis: r 1
W1(i) = v1 - v2
Next
x = 0
For j = z To 1 Step -1
If W1(j) < W2(j) Then x = -1: Exit For
If W1(j) > W2(j) Then x = 1: Exit For
Next
n = n + 1
Wend
If q < dj Then
resu = resu & n
x = 0
For j = 1 To z
If W1(j) > 0 Then x = 1: Exit For
Next
If x = 0 Then
For i = Len(resu) To di + 2 Step -1
If Mid$(resu, i, 1) <> chrz Then Exit For
Next If i di + 1 Then i di
resu = Left$(resu, i)
GoTo Fin
End If
Else
If n > 0 Then resu = resu & n
GoTo Fin
End If
' a$ = Mid$(a$, 2) & "0"
r = 0
For j = 1 To z
v1 = W1(j)
v2 = Int(v1 / puis2)
W1(j) = (v1 - v2 * puis2) * 10 + r
r = v2
Next
Next
Fin:
bDivision = sg & resu
End Function
Public Function bModulo(n1 As String, n2 As String) As String
Dim a As String
Dim b As String
Dim c As String
Dim resu As String
Dim sg As String
Dim di As Integer
Dim dj As Integer
Dim i As Long
Dim j As Long
Dim r As Integer
Dim n As Integer
Dim p As Integer
Dim puis2 As Double
Dim q As Integer
Dim v1 As Double
Dim v2 As Double
Dim x As Integer
Dim z As Integer
Dim W1() As Double
Dim W2() As Double
If Mid$(n2, 2) = chrz Then Err.Raise 11
parm = 14
puis = 10 ^ parm
frmt = String(parm, chrz)
puis2 = puis / 10
i = InStr(n1, sep)
j = InStr(n2, sep) If i > 0 Then a1 i - 2: b1 Len(n1) - i Else a1 = Len(n1) - 1: b1 = 0 If j > 0 Then a2 j - 2: b2 Len(n2) - j Else a2 = Len(n2) - 1: b2 = 0 If b1 > b2 Then pos b1 Else pos b2
i = a1 + pos
j = a2 + pos If i > j Then k i Else k j di k - j: dj k - i
k = k + parm - (k Mod parm)
a = String$(k - i - dj, chrz) & Mid$(n1, 2, a1) & Mid$(n1, a1 + 3, b1) & String$(pos - b1 + dj, chrz)
b = String$(k - j - di, chrz) & Mid$(n2, 2, a2) & Mid$(n2, a2 + 3, b2) & String$(pos - b2 + di, chrz) If Asc(n1) Asc(n2) Then sg "+" Else sg = "-"
di = di + 1
pos = pos + dj
z = k \ parm
ReDim W1(z), W2(z) ' et W3(z)
i = 1
For j = k + 1 - parm To 1 Step -parm
W1(i) = CDbl(Mid$(a, j, parm)) W2(i) CDbl(Mid$(b, j, parm)): i i + 1
Next
' x = StrComp(a, b, vbBinaryCompare)
x = 0
For j = z To 1 Step -1
If W1(j) < W2(j) Then x = -1: Exit For
If W1(j) > W2(j) Then x = 1: Exit For
Next
If dj > 0 Then
If x = -1 Then
dj = dj + 1
' a$ = Mid$(a$, 2) & "0"
r = 0
For j = 1 To z
v1 = W1(j)
v2 = Int(v1 / puis2)
W1(j) = (v1 - v2 * puis2) * 10 + r
r = v2
Next
End If
resu = "0": GoTo Fin
End If
If x = 0 Then
resu = "1" & String$(di - 1, chrz): GoTo Fin
End If
If x = -1 Then
If di > 1 Then
' b$ = "0" & Left$(b$, k - 1)
r = 0
For j = z To 1 Step -1
v1 = W2(j)
v2 = Int(v1 / 10)
W2(j) = v2 + r * puis2
r = v1 - v2 * 10
Next
di = di - 1
Else
' a$ = Mid$(a$, 2) & "0"
r = 0
For j = 1 To z
v1 = W1(j)
v2 = Int(v1 / puis2)
W1(j) = (v1 - v2 * puis2) * 10 + r
r = v2
Next
resu = resu & "0": GoTo Fin
End If
End If
Boucle1:
For q = 1 To di
x = 0
For j = z To 1 Step -1
If W1(j) < W2(j) Then x = -1: Exit For
If W1(j) > W2(j) Then x = 1: Exit For
Next
n = 0
While x <> -1
For i = 1 To z
v1 = W1(i) v2 W2(i) + r: r 0 If v1 < v2 Then v1 v1 + puis: r 1
W1(i) = v1 - v2
Next
x = 0
For j = z To 1 Step -1
If W1(j) < W2(j) Then x = -1: Exit For
If W1(j) > W2(j) Then x = 1: Exit For
Next
n = n + 1
Wend
If q < di Then
' b$ = "0" & Left$(b$, k - 1)
r = 0
For j = z To 1 Step -1
v1 = W2(j)
v2 = Int(v1 / 10)
W2(j) = v2 + r * puis2
r = v1 - v2 * 10
Next
End If
resu = resu & n
Next
j = 1
For i = z To 1 Step -1 Mid$(a$, j, parm) Format$(W1(i), frmt): j j + parm
Next
Fin:
Quotient = sg & resu
sg = Left$(n1, 1)
bModulo = Arrondi(a$, sg)
End Function
Private Function Arrondi(a As String, sg As String) As String
Dim i As Integer
Dim j As Integer
Dim x As Integer
Dim r As Long
Dim t As Double
Dim z As Integer
x = k + 1 - pos
' suppression des zéros devant
For i = 1 To x - 2
If Mid$(a$, i, 1) <> chrz Then Exit For
Next
' suppression des zéros derrière
For j = k To x Step -1
If Mid$(a$, j, 1) <> chrz Then Exit For
Next
a1 = x - i
b1 = j + 1 - x
If Tronq Then b2 preci - a1: If b2 < 0 Then b2 0
If b2 < b1 Then
If Mid$(a$, x + b2, 1) > "4" Then
z% = x + b2 - 1 j z% Mod parm: If j 0 Then j = parm
j = z% - j + 1
r = 10 ^ ((k - z%) Mod parm)
While r > 0
t = CDbl(Mid$(a$, j, parm)) + r
r = 0 If t >puis Then r 1: t = t - puis
Mid$(a$, j, parm) = Format$(t, frmt)
j = j - parm
Wend
End If If Mid$(a$, i - 1, 1) <> chrz Then i i - 1: a1 a1 + 1
For j = x + b2 - 1 To x Step -1
If Mid$(a$, j, 1) <> chrz Then Exit For
Next
b1 = j + 1 - x
End If
End If
Arrondi = sg & Mid$(a$, i, a1)
If b1 > 0 Then Arrondi = Arrondi & sep & Mid$(a$, x, b1)
End Function
Daniel
Gobillot
Messages postés
3140
Date d'inscription
vendredi 14 mai 2004
Statut
Membre
Dernière intervention
11 mars 2019
34
16 mars 2007 à 00:16
16 mars 2007 à 00:16
voici la nouvelle division modifiée, elle utilise maintenant Arrondi comme les autres opérations.
quelques bugs ont été corrigés dans Arrondi()
et en plus une autre opération a été ajoutée
calcul de racine carrée:
- première estimation en Double avec un maximum de chiffres
j'avais adapté la méthode John Carmak, mais elle était pas assez performante
je sais pas si vous connaissez le nombre magique &H5F3759DF (ou &H5F375A86)
pourtant simple à adapter en VB6 mais jamais trouvé sur le net:
Dim i As Long
Dim x As Single
Dim z As Single
CopyMemory i, x, 4&
i = &H5F375A86 - i / 2
CopyMemory z, i, 4&
Racine = z * x
- transformation en chaîne de cette estimation:
là aussi aucune instruction Format n'a été capable d'afficher tous les chiffres
et en plus il y avait dépassement de capacité en multipliant par une puissance de 10 trop grande
- ensuite calcul jusqu'à la précision demandée
par itération en utilisant la méthode de Héron x = ( n/x + x ) /2
'2 constantes en plus
Const sg1 = "+"
Const sg2 = "-"
Public Function bDivision(n1 As String, n2 As String) As String
Dim a As String
Dim b As String
Dim c As String
Dim resu As String
Dim sg As String
Dim di As Integer
Dim dj As Integer
Dim i As Integer
Dim j As Integer
Dim n As Integer
Dim p As Integer
Dim puis2 As Double
Dim q As Integer
Dim r As Integer
Dim v1 As Double
Dim v2 As Double
Dim x As Integer
Dim z As Integer
Dim W1() As Double
Dim W2() As Double
If Mid$(n2, 2) = chrz Then Err.Raise 11
parm = 14
puis = 10 ^ parm
frmt = String(parm, chrz)
puis2 = puis / 10
i = InStr(n1, sep)
j = InStr(n2, sep) If i > 0 Then a1 i - 2: b1 Len(n1) - i Else a1 = Len(n1) - 1: b1 = 0 If j > 0 Then a2 j - 2: b2 Len(n2) - j Else a2 = Len(n2) - 1: b2 = 0 If b1 > b2 Then pos b1 Else pos b2
i = a1 + pos
j = a2 + pos If i > j Then k i Else k j di k - j: dj k - i
k = k + parm - (k Mod parm)
a = String$(k - i - dj, chrz) & Mid$(n1, 2, a1) & Mid$(n1, a1 + 3, b1) & String$(pos - b1 + dj, chrz)
b = String$(k - j - di, chrz) & Mid$(n2, 2, a2) & Mid$(n2, a2 + 3, b2) & String$(pos - b2 + di, chrz) If Asc(n1) Asc(n2) Then sg sg1 Else sg = sg2
di = di + 1
pos 0: z k \ parm
ReDim W1(z), W2(z)
i = 1
For j = k + 1 - parm To 1 Step -parm
W1(i) = CDbl(Mid$(a, j, parm)) W2(i) CDbl(Mid$(b, j, parm)): i i + 1
Next
x = 0
For k = z To 1 Step -1
If W1(k) < W2(k) Then x = -1: Exit For
If W1(k) > W2(k) Then x = 1: Exit For
Next
If dj > 0 Then
If x = -1 Then
dj = dj + 1
r = 0
For j = 1 To z
v1 = W1(j)
v2 = Int(v1 / puis2)
W1(j) = (v1 - v2 * puis2) * 10 + r
r = v2
Next
End If
pos = dj - 1
p = 1: GoTo Boucle2
End If
If x = 0 Then
resu = "1" & String$(di - 1, chrz): GoTo Fin
End If
If x = -1 Then
If di > 1 Then
r = 0
For j = z To 1 Step -1
v1 = W2(j)
v2 = Int(v1 / 10)
W2(j) = v2 + r * puis2
r = v1 - v2 * 10
Next
di = di - 1
Else
r = 0
For j = 1 To z
v1 = W1(j)
v2 = Int(v1 / puis2)
W1(j) = (v1 - v2 * puis2) * 10 + r
r = v2
Next
p = 1: GoTo Boucle2
End If
End If
Boucle1:
For q = 1 To di
x = 0
For k = z To 1 Step -1
If W1(k) < W2(k) Then x = -1: Exit For
If W1(k) > W2(k) Then x = 1: Exit For
Next
n = 0
While x <> -1
For i = 1 To z
v1 = W1(i) v2 W2(i) + r: r 0 If v1 < v2 Then v1 v1 + puis: r 1
W1(i) = v1 - v2
Next
x = 0
For k = z To 1 Step -1
If W1(k) < W2(k) Then x = -1: Exit For
If W1(k) > W2(k) Then x = 1: Exit For
Next
n = n + 1
Wend
If q < di Then
r = 0
For j = z To 1 Step -1
v1 = W2(j)
v2 = Int(v1 / 10)
W2(j) = v2 + r * puis2
r = v1 - v2 * 10
Next
End If
resu = resu & n
Next
r = 0
For j = 1 To z
v1 = W1(j)
v2 = Int(v1 / puis2)
W1(j) = (v1 - v2 * puis2) * 10 + r
r = v2
Next
Boucle2:
dj = preci + 1 - di + p
For q = 1 To dj
x = 0
For k = z To 1 Step -1
If W1(k) < W2(k) Then x = -1: Exit For
If W1(k) > W2(k) Then x = 1: Exit For
Next
n = 0
While x <> -1
For i = 1 To z
v1 = W1(i) v2 W2(i) + r: r 0 If v1 < v2 Then v1 v1 + puis: r 1
W1(i) = v1 - v2
Next
x = 0
For k = z To 1 Step -1
If W1(k) < W2(k) Then x = -1: Exit For
If W1(k) > W2(k) Then x = 1: Exit For
Next
n = n + 1
Wend resu resu & n: pos pos + 1
If q < dj Then
For k = 1 To z
If W1(k) > 0 Then
r = 0
For j = 1 To z
v1 = W1(j)
v2 = Int(v1 / puis2)
W1(j) = (v1 - v2 * puis2) * 10 + r
r = v2
Next
Exit For
End If
Next
Else
q = dj
End If
Next
Fin:
q = Len(resu)
k = q + parm - (q Mod parm)
a$ = String$(k - q, chrz) & resu
bDivision = Arrondi(a$, sg)
End Function
Private Function Arrondi(a As String, sg As String) As String
Dim i As Integer
Dim j As Integer
Dim x As Integer
Dim r As Double
Dim t As Double
Dim z As Integer
x = k + 1 - pos
For i = 1 To k
If Mid$(a$, i, 1) <> chrz Then Exit For
Next
For j = k To x Step -1
If Mid$(a$, j, 1) <> chrz Then Exit For
Next
a2 = x - i If a2 > 0 Then a1 a2 Else a1 1: i = x - 1
b1 = j + 1 - x
If Tronq Then b2 preci - a2: If b2 < 0 Then b2 0
If b2 < b1 Then
If Mid$(a$, x + b2, 1) > "4" Then
z% = x + b2 - 1 j z% Mod parm: If j 0 Then j = parm
j = z% - j + 1
r = 10 ^ ((k - z%) Mod parm)
While r > 0
t = CDbl(Mid$(a$, j, parm)) + r
r = 0 If t >puis Then r 1: t = t - puis
Mid$(a$, j, parm) = Format$(t, frmt)
j = j - parm
Wend
End If If Mid$(a$, i - 1, 1) <> chrz Then i i - 1: a1 a1 + 1
For j = x + b2 - 1 To x Step -1
If Mid$(a$, j, 1) <> chrz Then Exit For
Next
b1 = j + 1 - x
End If
End If
Arrondi = sg & Mid$(a$, i, a1)
If b1 > 0 Then Arrondi = Arrondi & sep & Mid$(a$, x, b1)
End Function
Public Function bRacine(n1 As String) As String
Dim a As String
Dim b As String
Dim c As String
Dim ex As Integer
Dim i As Integer
Dim j As Integer
Dim x As Integer
Dim W1 As Double
Dim W2 As Double
If Asc(n1) = 45 Then Err.Raise 5
i = InStr(n1, sep) If i > 0 Then a1 i - 2 Else a1 Len(n1) - 1
If a1 < 16 Then k% 0: W1 CDbl(n1)
Else If (a1 And 1) 0 Then b2 15 Else b2 = 16 k% (a1 - b2 + 1) \ 2: W1 CDbl(Left$(n1, b2))
End If
W2 = Sqr(W1)
c$ = Format$(W2, "###############E+")
ex = Mid$(c$, 17) + k
If ex >= 0 Then a1 15: a2 ex: x = 0
Else
ex = -ex
If ex >= 15 Then a1 0: a2 1: b1 = ex - 15
Else a1 15 - ex: a2 0: b1 = 0
End If
For i = 15 To a1 + 1 Step -1
If Mid$(a$, i, 1) <> "0" Then Exit For
Next b2 i - a1: x b1 + b2
End If
a$ = sg1 & Left$(c$, a1) & String$(a2, chrz)
If x Then a$ = a$ & sep & String$(b1, chrz) & Mid$(c$, a1 + 1, b2)
c$ = "+2"
x = 1
Do
b$ = a$
a$ = bDivision(n1, b$)
a$ = bAddition(a$, b$)
a$ = bDivision(a$, c$)
x = StrComp(a$, b$)
Loop Until x = 0
bRacine = a$
End Function
Daniel
quelques bugs ont été corrigés dans Arrondi()
et en plus une autre opération a été ajoutée
calcul de racine carrée:
- première estimation en Double avec un maximum de chiffres
j'avais adapté la méthode John Carmak, mais elle était pas assez performante
je sais pas si vous connaissez le nombre magique &H5F3759DF (ou &H5F375A86)
pourtant simple à adapter en VB6 mais jamais trouvé sur le net:
Dim i As Long
Dim x As Single
Dim z As Single
CopyMemory i, x, 4&
i = &H5F375A86 - i / 2
CopyMemory z, i, 4&
Racine = z * x
- transformation en chaîne de cette estimation:
là aussi aucune instruction Format n'a été capable d'afficher tous les chiffres
et en plus il y avait dépassement de capacité en multipliant par une puissance de 10 trop grande
- ensuite calcul jusqu'à la précision demandée
par itération en utilisant la méthode de Héron x = ( n/x + x ) /2
'2 constantes en plus
Const sg1 = "+"
Const sg2 = "-"
Public Function bDivision(n1 As String, n2 As String) As String
Dim a As String
Dim b As String
Dim c As String
Dim resu As String
Dim sg As String
Dim di As Integer
Dim dj As Integer
Dim i As Integer
Dim j As Integer
Dim n As Integer
Dim p As Integer
Dim puis2 As Double
Dim q As Integer
Dim r As Integer
Dim v1 As Double
Dim v2 As Double
Dim x As Integer
Dim z As Integer
Dim W1() As Double
Dim W2() As Double
If Mid$(n2, 2) = chrz Then Err.Raise 11
parm = 14
puis = 10 ^ parm
frmt = String(parm, chrz)
puis2 = puis / 10
i = InStr(n1, sep)
j = InStr(n2, sep) If i > 0 Then a1 i - 2: b1 Len(n1) - i Else a1 = Len(n1) - 1: b1 = 0 If j > 0 Then a2 j - 2: b2 Len(n2) - j Else a2 = Len(n2) - 1: b2 = 0 If b1 > b2 Then pos b1 Else pos b2
i = a1 + pos
j = a2 + pos If i > j Then k i Else k j di k - j: dj k - i
k = k + parm - (k Mod parm)
a = String$(k - i - dj, chrz) & Mid$(n1, 2, a1) & Mid$(n1, a1 + 3, b1) & String$(pos - b1 + dj, chrz)
b = String$(k - j - di, chrz) & Mid$(n2, 2, a2) & Mid$(n2, a2 + 3, b2) & String$(pos - b2 + di, chrz) If Asc(n1) Asc(n2) Then sg sg1 Else sg = sg2
di = di + 1
pos 0: z k \ parm
ReDim W1(z), W2(z)
i = 1
For j = k + 1 - parm To 1 Step -parm
W1(i) = CDbl(Mid$(a, j, parm)) W2(i) CDbl(Mid$(b, j, parm)): i i + 1
Next
x = 0
For k = z To 1 Step -1
If W1(k) < W2(k) Then x = -1: Exit For
If W1(k) > W2(k) Then x = 1: Exit For
Next
If dj > 0 Then
If x = -1 Then
dj = dj + 1
r = 0
For j = 1 To z
v1 = W1(j)
v2 = Int(v1 / puis2)
W1(j) = (v1 - v2 * puis2) * 10 + r
r = v2
Next
End If
pos = dj - 1
p = 1: GoTo Boucle2
End If
If x = 0 Then
resu = "1" & String$(di - 1, chrz): GoTo Fin
End If
If x = -1 Then
If di > 1 Then
r = 0
For j = z To 1 Step -1
v1 = W2(j)
v2 = Int(v1 / 10)
W2(j) = v2 + r * puis2
r = v1 - v2 * 10
Next
di = di - 1
Else
r = 0
For j = 1 To z
v1 = W1(j)
v2 = Int(v1 / puis2)
W1(j) = (v1 - v2 * puis2) * 10 + r
r = v2
Next
p = 1: GoTo Boucle2
End If
End If
Boucle1:
For q = 1 To di
x = 0
For k = z To 1 Step -1
If W1(k) < W2(k) Then x = -1: Exit For
If W1(k) > W2(k) Then x = 1: Exit For
Next
n = 0
While x <> -1
For i = 1 To z
v1 = W1(i) v2 W2(i) + r: r 0 If v1 < v2 Then v1 v1 + puis: r 1
W1(i) = v1 - v2
Next
x = 0
For k = z To 1 Step -1
If W1(k) < W2(k) Then x = -1: Exit For
If W1(k) > W2(k) Then x = 1: Exit For
Next
n = n + 1
Wend
If q < di Then
r = 0
For j = z To 1 Step -1
v1 = W2(j)
v2 = Int(v1 / 10)
W2(j) = v2 + r * puis2
r = v1 - v2 * 10
Next
End If
resu = resu & n
Next
r = 0
For j = 1 To z
v1 = W1(j)
v2 = Int(v1 / puis2)
W1(j) = (v1 - v2 * puis2) * 10 + r
r = v2
Next
Boucle2:
dj = preci + 1 - di + p
For q = 1 To dj
x = 0
For k = z To 1 Step -1
If W1(k) < W2(k) Then x = -1: Exit For
If W1(k) > W2(k) Then x = 1: Exit For
Next
n = 0
While x <> -1
For i = 1 To z
v1 = W1(i) v2 W2(i) + r: r 0 If v1 < v2 Then v1 v1 + puis: r 1
W1(i) = v1 - v2
Next
x = 0
For k = z To 1 Step -1
If W1(k) < W2(k) Then x = -1: Exit For
If W1(k) > W2(k) Then x = 1: Exit For
Next
n = n + 1
Wend resu resu & n: pos pos + 1
If q < dj Then
For k = 1 To z
If W1(k) > 0 Then
r = 0
For j = 1 To z
v1 = W1(j)
v2 = Int(v1 / puis2)
W1(j) = (v1 - v2 * puis2) * 10 + r
r = v2
Next
Exit For
End If
Next
Else
q = dj
End If
Next
Fin:
q = Len(resu)
k = q + parm - (q Mod parm)
a$ = String$(k - q, chrz) & resu
bDivision = Arrondi(a$, sg)
End Function
Private Function Arrondi(a As String, sg As String) As String
Dim i As Integer
Dim j As Integer
Dim x As Integer
Dim r As Double
Dim t As Double
Dim z As Integer
x = k + 1 - pos
For i = 1 To k
If Mid$(a$, i, 1) <> chrz Then Exit For
Next
For j = k To x Step -1
If Mid$(a$, j, 1) <> chrz Then Exit For
Next
a2 = x - i If a2 > 0 Then a1 a2 Else a1 1: i = x - 1
b1 = j + 1 - x
If Tronq Then b2 preci - a2: If b2 < 0 Then b2 0
If b2 < b1 Then
If Mid$(a$, x + b2, 1) > "4" Then
z% = x + b2 - 1 j z% Mod parm: If j 0 Then j = parm
j = z% - j + 1
r = 10 ^ ((k - z%) Mod parm)
While r > 0
t = CDbl(Mid$(a$, j, parm)) + r
r = 0 If t >puis Then r 1: t = t - puis
Mid$(a$, j, parm) = Format$(t, frmt)
j = j - parm
Wend
End If If Mid$(a$, i - 1, 1) <> chrz Then i i - 1: a1 a1 + 1
For j = x + b2 - 1 To x Step -1
If Mid$(a$, j, 1) <> chrz Then Exit For
Next
b1 = j + 1 - x
End If
End If
Arrondi = sg & Mid$(a$, i, a1)
If b1 > 0 Then Arrondi = Arrondi & sep & Mid$(a$, x, b1)
End Function
Public Function bRacine(n1 As String) As String
Dim a As String
Dim b As String
Dim c As String
Dim ex As Integer
Dim i As Integer
Dim j As Integer
Dim x As Integer
Dim W1 As Double
Dim W2 As Double
If Asc(n1) = 45 Then Err.Raise 5
i = InStr(n1, sep) If i > 0 Then a1 i - 2 Else a1 Len(n1) - 1
If a1 < 16 Then k% 0: W1 CDbl(n1)
Else If (a1 And 1) 0 Then b2 15 Else b2 = 16 k% (a1 - b2 + 1) \ 2: W1 CDbl(Left$(n1, b2))
End If
W2 = Sqr(W1)
c$ = Format$(W2, "###############E+")
ex = Mid$(c$, 17) + k
If ex >= 0 Then a1 15: a2 ex: x = 0
Else
ex = -ex
If ex >= 15 Then a1 0: a2 1: b1 = ex - 15
Else a1 15 - ex: a2 0: b1 = 0
End If
For i = 15 To a1 + 1 Step -1
If Mid$(a$, i, 1) <> "0" Then Exit For
Next b2 i - a1: x b1 + b2
End If
a$ = sg1 & Left$(c$, a1) & String$(a2, chrz)
If x Then a$ = a$ & sep & String$(b1, chrz) & Mid$(c$, a1 + 1, b2)
c$ = "+2"
x = 1
Do
b$ = a$
a$ = bDivision(n1, b$)
a$ = bAddition(a$, b$)
a$ = bDivision(a$, c$)
x = StrComp(a$, b$)
Loop Until x = 0
bRacine = a$
End Function
Daniel
