Bandeau Xylak
Bandeau LOCUS SOLUTUS
Bandeau arc-en-ciel
    Brimborions
     xylakaviens
fbNauvatag
xyljack.net


Oyiwen ed tanemert_______Page mise à jour le 6 janvier 2018 vers 08h10 TUC    

  Il y a quelques années, j'avais publié sur le forum de MoteurProg une série de messages consacrés aux nombres à virgule flottante, encodés selon la norme IEEE 754. Voici une copie de ce fil - qui développe et commente une partie du programme ProBin, présenté dans cette page  [⇒].
NB- Le texte n'a été ni revu ni corrigé ; seules modifications :
  • la mise en page, pour mieux adapter à ce site le format d'un forum vBulletin® ;
  • dans le code source de la page, certains signes (par exemple < et >) ont été remplacés par des entités, pour éviter toute confusion avec les balises HTML ; ils devraient apparaître normalement dans un copier-coller du navigateur.

Message du 15/09/2012, 21h30

Ia ora na.

Pour rompre un silence qui se prolonge, voici une fonction VirgFlot() qui transforme une chaîne contenant un nombre décimal de type simple précision en une chaîne de trente-deux bits représentant un nombre à virgule flottante, au plus près possible de la norme IEEE754.
« !! » Il s'agit d'un travail expérimental, qui ne saurait en aucun cas être utilisé dans un projet où une erreur (voire un défaut) de programmation pourrait avoir des conséquences dommageables.
« !! » Pour une raison mal déterminée, dans certains nombres comportant une partie décimale, la valeur renvoyée par VirgFlot est inférieure d'une unité à la valeur attendue :

 VirgFlotIEEE 754
1246,00006103515625449BC000449BC001

Ce document se compose de 4 parties :
A} présentation de la fonction et mode d'emploi
B} code de la fonction VirgFlot et de trois fonctions associées
C} code d'une page VB6 (VFlo1.frm) comportant une interface pour tester la fonction
D} commentaires et fonction périphériques (messages suivants)


Bon courage à toutes et à tous.


A} présentation de la fonction et mode d'emploi
1) VirgFlot et la norme
NB1- La norme IEEE754 (qui définit les trois sortes de nombres à virgule flottante, dont celui qui est calculé ici, sur quatre octets) prévoit que le plus grand nombre exprimable est de l'ordre de 340 282 360 000 000 000 000 000 000 000 000 000 000 ( = 3,4028236 e38 ; et c'est en effet la valeur maximale d'une variable VB en simple précision) ; la fonction ci-dessous respecte apparemment cette limite (voir NB2). A l'opposé, le nombre le plus petit (en valeur absolue) doit être de l'ordre de 1.4e-45 ; comme mentionné plus haut, certains résultats sont inférieurs de 1 à la valeur attendue ; de plus, pour la même (ou pour une autre) raison, les valeurs renvoyées par VirgFlot s'éloignent de plus en plus de ce qui est attendu à partir de 1e-38 ; pour éviter toute erreur, la fonction renvoie dans ce cas Trop petit (à comprendre comme trop petit pour VirgFlot, mais pas nécessairement pour la norme).
NB2- La norme précitée prévoit de plus de réserver les valeurs extrêmes pour des nombres spéciaux : + infini, - infini et NaN (que l'on pourrait traduire en français par PuN = pas un nombre) ; les deux premiers semblent respectés ; le troisième n'a pas de raison d'être ici puisqu'il ne peut être que le résultat d'une opération.
NB3- Enfin, la même norme prévoit plusieurs sortes d'arrondis (au plus proche, vers 0, vers plus l'infini et vers moins l'infini) ; la fonction ci-dessous laisse VB maître en la matière (d'où peut-être les différences observées en NB1).
2) Mode d'emploi
NB4- La première version utilisait comme paramètre une valeur en simple précision ; ce format a été remplacé par un nombre sous forme de chaîne de caractères pour deux raisons : a} un peu anecdotique : une particularité de ces nombres à virgule flottante est de distinguer un zéro positif d'un zéro négatif ; les variables numériques de VB ne le permettent pas ;
b} plus généralement, le problème des limites (dont il sera plus largement question dans la partie D}) rendait ce changement nécessaire.
NB5- Formats d'entrée : on peut utiliser la virgule ou le point comme séparateur décimal, et indiquer le nombre en notation scientifique (sous la forme 1.23e-4 ; mais pas avec 10 puissance -4).
NB6- Le code est accompagné de quelques commentaires ; on trouvera notamment, dans VirgFlot, des commentaires commençant par 'z et ayant trait au traitement de la valeur 0 (dont on comprendra facilement qu'elle puisse poser quelque problème). D'autres commentaires plus périphériques pourront être trouvés dans la partie D}.
3) Tests et vérifications
NB7- remarque amusée (ou désabusée, au choix) : quand, dans un programme, on écrit N! = 98.125, VB enregistre automatiquement cette valeur sous la forme 00 40 C4 42 ; au temps des bons vieux Basic, on pouvait obtenir l'adresse-mémoire de la variable (par VarPtr) et, (à coups de Peek(), si je me souviens bien), récupérer les quatre valeurs ; mais VB est un langage évolué, qui ne dévoile plus son intimité - et on ne pourra pas utiliser ce procédé trop simple pour vérifier l'exactitude des résultats.
NB8- Comme dans le projet de la sentinelle, les tests sont restés basiques : une vingtaine de valeurs ; pour la vérification, j'ai utilisé FFEditc_unicode.exe (de Train Simulator), qui peut assurer (entre autres) cette transformation ; je n'ai pas noté de divergences autres que celles qui ont été signalées ci-dessus.
NB9- En dehors même de Train Simulator, on trouvera sur le Web un ou plusieurs sites offrant une conversion aussi complète, précise et sûre que celle de VB ou MSTS (et permettant en plus de choisir le type d'arrondi) ; si le code ci-dessous peut valoir un détour, ce n'est pas pour le résultat qu'il produit mais pour le chemin qui y mène.
xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx

B} Code

On trouvera ici quatre sections de code :
1) la fonction VirgFlot() ;
2) la fonction EnForme(), appelée par VirgFlot (pour mettre le paramètre au format voulu) ;
3) la fonction DéciBin(), appelée par VirgFlot (pour transformer en bits la partie entière) ;
4) la fonction BinHexa() transformant les 32 bits renvoyés par VirgFlot en quatre octets sous différents formats :
•   naturel (octet de poids fort en tête) ou Intel (octet de poids faible d'abord),
•   8 chiffres groupés (double mot) ou en deux groupes (par mot) ou par octet.
1)

Private Function VirgFlot(Num$) As String
Dim Nb$, Bin$, I%, VgF$, S$, Ex$, PF#, BinE$, BinF$, DN%, Fr#, X%
 
'* fixer le bit de signe / convertir négatif > positif
S$ = "0": Num$ = Trim$(Num$): If Left$(Num$, 1) = "-" Then S$ = "1": Num$ = Mid$(Num$, 2)
Num$ = EnForme(Num$) '<-- voir EnForme() pour les formats reconnus
I% = InStr(Num$, "."): If I% = 0 Then Exit Function '<-- format erroné / traité par BinHexa
'* convertir la partie entière en 128 bits
BinE$ = DéciBin(Left$(Num$, I% - 1)): X% = 0 '<-- indicateur de dépassement
If Len(BinE$) < 128 Then
  BinE$ = String$(128 - Len(BinE$), "0") & BinE$
Else
'* fixe la limite à 3.40282356e38
  If (Len(BinE$) > 128) Or (BinE$ > "111111111111111111111111011101100010100010001011011011101010000010100000000010000110010000000" & _ "10100000000000000000000000000000000") Then
    '* 127 bits de poids faible à 0 ( 7F800000 )
    BinE$ = "1" & String$(127, "0"): X% = 1
  End If
End If
'* normaliser la partie entière (décalage vers la gauche jusqu'à ce que le bit de poids le plus fort soit 1)
'* la boucle examine seulement les 127 bits de poids fort (jusqu'à DN% = 128) ;
'z si elle n'est pas interrompue, elle laisse dans BinE$ le bit de poids le plus faible (ici, "0"), avec DN% = 127
For DN% = 254 + X% To 128 Step -1
  If Left$(BinE$, 1) = "1" Then Exit For
  BinE$ = Mid$(BinE$, 2)
Next
'* convertir la partie décimale en fraction binaire
PF# = Val(Mid$(Num$, I%))
If PF# > 0 Then
  If (PF# < 1E-38) And (Len(BinE$) < 32) Then VirgFlot = "<": Exit Function '<-- nombre trop petit
  For I% = 1 To 150
    Fr# = 1 / (2 ^ I%)
    If PF# - Fr# >= 0 Then
      PF# = PF# - Fr#: BinF$ = BinF$ & "1"
    Else
      BinF$ = BinF$ & "0"
    End If
  Next
End If
'* assembler entier|fractionnaire
VgF$ = BinE$ & BinF$
'* normaliser l'ensemble
'z si N!=0, BinE$=0 et BinF$="", donc VgF$="0" ; toute la boucle suivante sera à nouveau déroulée, sans trouver de "1" ;
'z donc, à la sortie, VgF$="" et DN%=0
For DN% = DN% To 1 Step -1
  If Left$(VgF$, 1) = "1" Then Exit For
  VgF$ = Mid$(VgF$, 2)
Next
'* cadrer entier|fractionnaire sur 24 bits
If Len(VgF$) > 24 Then
  VgF$ = Left$(VgF$, 24)
Else
  VgF$ = VgF$ & String$(24 - Len(VgF$), "0") '<--z VgF$= 24 fois "0"
End If
'* supprimer le bit de poids le plus fort
VgF$ = Mid$(VgF$, 2) '<--z VgF$= 23 fois "0" (donc identique à 1, 2, 4, etc. ; seul l'exposant décide)
'* transformer le nombre de décalages en exposant
BinE$ = DéciBin(Format$(DN%)): BinE$ = String$(8 - Len(BinE$), "0") & BinE$
'* assembler les 32 bits = 1 + 8 + 23 / z : "0" ou "1" suivi de 31 "0"
VgF$ = S$ & BinE$ & VgF$
VirgFlot = VgF$
 
End Function

2)
Private Function EnForme(N$) As String
'* cette fonction supprime les espaces, remplace la virgule par un point, met en "tous chiffres" la notation scientifique ;
'* si N$ est d'un format non reconnu, renvoie "" ;
'* en dehors de ce cas, la chaîne renvoyée contient tjs un point décimal : 12. pour 12
Dim NN$, I%, CS$, E%, V%
 
NN$ = Replace(N$, ",", "."): I% = InStr(NN$, ".")
If InStr(I% + 1, NN$, ".") > 0 Then '<- présence de plusieurs séparateurs
  Exit Function
End If
NN$ = Replace(NN$, " ", ""): I% = InStr(1, NN$, "e", vbTextCompare)
If I% > 0 Then '<- notation algébrique : CS$ = chiffres significatifs / V% = rang de la virgule / E% = exposant
  CS$ = Left$(NN$, I% - 1): V% = InStr(CS$, "."): E% = Val(Mid$(NN$, I% + 1))
  If Abs(E%) > 45 Then Exit Function
'* CS$--vvvvvv v-- E%
'* 12.789e4
'* V% --^
  CS$ = String$(45, "0") & CS$ & IIf(V% > 0, "", ".") & String$(45, "0"): V% = InStr(CS$, ".")
'* encadrement de CS$ par des zéros v% --v
'* 12.789e4 >>> 0000000000000000000000012.78900000000000000000000000
'* 12e-4 >>> 0000000000000000000000012.000000000000000000000000
'* déplacement de la virgule en |
  V% = V% + E% 'v>>>|
'* 12.789e4 >>> 000000000000000000000001278900000000000000000000000
'* 12e-4 >>> 0000000000000000000000012000000000000000000000000
'* |<<<^
'* réécriture du nombre
   CS$ = Replace(CS$, ".", ""): CS$ = Left$(CS$, V% - 1) & "." & Mid$(CS$, V%)
  '* suppression des zéros non signaficatifs
  Do While Left$(CS$, 1) = "0": CS$ = Mid$(CS$, 2): Loop
  Do While Right$(CS$, 1) = "0": CS$ = Left$(CS$, Len(CS$) - 1): Loop
'* cas particuliers : 0012.000 >> 12. (facilite l'interprétation dans VirgFlot)
' 0000.120 >> .12 (reconnu naturellement par VB)
  NN$ = CS$
Else
'* ajout d'un point décimal à droite des nombres entiers
  If InStr(NN$, ".") = 0 Then NN$ = NN$ & "."
End If
EnForme = NN$
 
End Function

3)
Private Function DéciBin(Nb$) As String
'* cette fonction contruit la chaîne des bits par divisions par 2 successives du nombre décimal
Dim I%, V%, R%, T$, N$, B$
 
Do '<-- à chaque itération, Nb$ vaut la moitié de l'itération précédente
  '* pour chaque chiffre décimal de Nb$
  For I% = 1 To Len(Nb$)
    V% = Val(T$ & Mid$(Nb$, I%, 1)) '<-- valeur à diviser par 2 : ("1" si retenue) & (chiffre)
    R% = V% \ 2: N$ = N$ & Format$(R%) '<-- remplacement du chiffre par sa moitié
    T$ = Format$(V% Mod 2) '<-- retenue s'il y a lieu
  Next
  B$ = T$ & B$ '<-- chaîne binaire (construite à l'issue de chaque division, en partant du bit le plus faible)
  Nb$ = IIf(Left$(N$, 1) = "0", Mid$(N$, 2), N$) '<-- Nb$ << résultat de la division par 2
  N$ = "": T$ = "" ' + suppression du zéro de gauche s'il y a lieu
Loop Until Nb$ = "" '<-- jusqu'à ce que val(Nb$) = 1\2 = 0 (cf. ci-dessus)
DéciBin = B$
 
End Function

4)
Private Function BinHexa(B$, Optional M% = 2) As String
'* transforme une chaîne de 32 bits en quatre octets au format naturel (M% < 0) ou Intel (M% > 0)
'* Abs(M%) indique le nombre de chiffres hexa par groupe ; par exemple, pour la valeur 1 décimal :
' M%=-8 >> 3F800000 / M%=8 >> 0000803F
' M%=-4 >> 3F80 0000 / M%=4 >> 0000 803F
' M%=-2 >> 3F 80 00 00 / M%=2 >> 00 00 80 3F (valeur par défaut)
'* renvoie "non valide" ou "trop petit" en cas d'échec de VirgFlot
Dim I%, K%, V%, H$, Hi$, Q$
 
Select Case B$
  Case "": H$ = "non valide"
  Case "<": H$ = "trop petit"
  Case Else
    '* convertir 32 bits en 8 chiffres hexa
    For I% = 1 To 32 Step 4
      Q$ = Mid$(B$, I%, 4): V% = 0
      For K% = 1 To 4
        If Mid$(Q$, K%, 1) = "1" Then V% = V% + 2 ^ (4 - K%)
      Next
      H$ = H$ & Hex$(V%)
    Next
    If M% > 0 Then
      '* réordonner les 8 chiffres
      For I% = 1 To 8 Step 2
        Hi$ = Mid$(H$, I%, 2) & Hi$
      Next
    Else
      Hi$ = H$: M% = Abs(M%)
    End If
    '* formater
    H$ = ""
    Select Case M%
      Case 8: H$ = Hi$
      Case 4: H$ = Left$(Hi$, 4) & " " & Right$(Hi$, 4)
      Case Else
        For I% = 1 To 8 Step 2: H$ = H$ & Mid$(Hi$, I%, 2) & " ": Next
        H$ = RTrim$(H$)
    End Select
End Select
BinHexa = H$
 
End Function
xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx

C} Interface

Pour qui souhaiterait essayer ces fonctions, voici une feuille complète créant une interface simplifiée ; il suffit d'en copier-coller le code dans le bloc-notes, de sauvegarder sur le disque avec l'extension .frm puis de créer un projet VB dans lequel on remplacera la page d'origine par celle-ci ;
NB- les quatre fonctions de B} sont incluses dans la feuille ci-dessous, mais les commentaires en sont absents.


VERSION 5.00
Begin VB.Form VFlo1
   Caption = "vflo"
   ClientHeight = 2844
   ClientLeft = 48
   ClientTop = 540
   ClientWidth = 3432
   LinkTopic = "form1"
   MaxButton = 0 'False
   ScaleHeight = 2844
   ScaleWidth = 3432
   StartUpPosition = 2 'CenterScreen
   Begin VB.CommandButton btCopie
      Caption = "copier dans le presse-papiers"
      BeginProperty Font
         Name = "comic sans ms"
         Size = 10.2
         Charset = 0
         Weight = 400
         Underline = 0 'False
         Italic = 0 'False
         Strikethrough = 0 'False
      EndProperty
      Height = 372
      Left = 60
      TabIndex = 11
      Top = 2460
      Width = 3312
   End
   Begin VB.CommandButton btRàz
      Caption = "ràz"
      BeginProperty Font
         Name = "comic sans ms"
         Size = 10.2
         Charset = 0
         Weight = 400
         Underline = 0 'False
         Italic = 0 'False
         Strikethrough = 0 'False
      EndProperty
      Height = 372
      Left = 2880
      TabIndex = 10
      Top = 60
      Width = 492
   End
   Begin VB.CommandButton btConver
      Caption = "convertir"
      BeginProperty Font
         Name = "comic sans ms"
         Size = 10.8
         Charset = 0
         Weight = 400
         Underline = 0 'False
         Italic = 0 'False
         Strikethrough = 0 'False
      EndProperty
      Height = 612
      Left = 120
      TabIndex = 2
      Top = 1740
      Width = 1332
   End
   Begin VB.TextBox txNbre
      BeginProperty Font
         Name = "lucida console"
         Size = 10.8
         Charset = 0
         Weight = 400
         Underline = 0 'False
         Italic = 0 'False
         Strikethrough = 0 'False
      EndProperty
      Height = 372
      Left = 60
      TabIndex = 0
      Top = 60
      Width = 2772
   End
   Begin VB.Frame caFormat
      BorderStyle = 0 'None
      Height = 1332
      Left = 1140
      TabIndex = 3
      Tag = "2"
      Top = 360
      Width = 2292
      Begin VB.OptionButton coFormat
         Caption = "1122aabb"
         BeginProperty Font
            Name = "lucida console"
            Size = 10.2
            Charset = 0
            Weight = 400
            Underline = 0 'False
            Italic = 0 'False
            Strikethrough = 0 'False
         EndProperty
         Height = 312
         Index = 0
         Left = 120
         Style = 1 'Graphical
         TabIndex = 6
         Top = 180
         Width = 2052
      End
      Begin VB.OptionButton coFormat
         Caption = "1122 aabb"
         BeginProperty Font
            Name = "lucida console"
            Size = 10.2
            Charset = 0
            Weight = 400
            Underline = 0 'False
            Italic = 0 'False
            Strikethrough = 0 'False
         EndProperty
         Height = 312
         Index = 1
         Left = 120
         Style = 1 'Graphical
         TabIndex = 5
         Top = 540
         Width = 2052
      End
      Begin VB.OptionButton coFormat
         Caption = "11 22 aa bb"
         BeginProperty Font
            Name = "lucida console"
            Size = 10.2
            Charset = 0
            Weight = 400
            Underline = 0 'False
            Italic = 0 'False
            Strikethrough = 0 'False
         EndProperty
         Height = 312
         Index = 2
         Left = 120
         Style = 1 'Graphical
         TabIndex = 4
         Top = 900
         Value = -1 'True
         Width = 2052
      End
   End
   Begin VB.Frame caMode
      Height = 1092
      Left = 60
      TabIndex = 7
      Tag = "i"
      Top = 420
      Width = 1092
      Begin VB.OptionButton coMode
         Caption = "intel"
         BeginProperty Font
            Name = "arial"
            Size = 10.2
            Charset = 0
            Weight = 400
            Underline = 0 'False
            Italic = 0 'False
            Strikethrough = 0 'False
         EndProperty
         Height = 372
         Index = 1
         Left = 120
         Style = 1 'Graphical
         TabIndex = 9
         Top = 600
         Value = -1 'True
         Width = 852
      End
      Begin VB.OptionButton coMode
         Caption = "naturel"
         BeginProperty Font
            Name = "arial"
            Size = 10.2
            Charset = 0
            Weight = 400
            Underline = 0 'False
            Italic = 0 'False
            Strikethrough = 0 'False
         EndProperty
         Height = 372
         Index = 0
         Left = 120
         Style = 1 'Graphical
         TabIndex = 8
         Top = 180
         Width = 852
      End
   End
   Begin VB.Label étHexa
      Alignment = 2 'Center
      BorderStyle = 1 'Fixed Single
      BeginProperty Font
         Name = "lucida console"
         Size = 10.8
         Charset = 0
         Weight = 400
         Underline = 0 'False
         Italic = 0 'False
         Strikethrough = 0 'False
      EndProperty
      Height = 612
      Left = 1620
      TabIndex = 1
      Top = 1740
      Width = 1692
   End
End
Attribute VB_Name = "vflo1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
 
Private Function VirgFlot(Num$) As String
Dim Nb$, Bin$, I%, VgF$, S$, Ex$, PF#, BinE$, BinF$, DN%, Fr#, X%
 
S$ = "0": Num$ = Trim$(Num$): If Left$(Num$, 1) = "-" Then S$ = "1": Num$ = Mid$(Num$, 2)
Num$ = EnForme(Num$)
I% = InStr(Num$, "."): If I% = 0 Then Exit Function
BinE$ = DéciBin(Left$(Num$, I% - 1)): X% = 0
If Len(BinE$) < 128 Then
  BinE$ = String$(128 - Len(BinE$), "0") & BinE$
Else
  If (Len(BinE$) > 128) Or (BinE$ >
 
"111111111111111111111111011101100010100010001011011011101010000010100000000010000110010000000" & _ "101000000000000000000000000000000000") then
    BinE$ = "1" & String$(127, "0"): X% = 1
  End If
End If
For DN% = 254 + X% To 128 Step -1
  If Left$(BinE$, 1) = "1" Then Exit For
  BinE$ = Mid$(BinE$, 2)
Next
PF# = Val(Mid$(Num$, I%))
If PF# > 0 Then
  If (PF# < 1E-38) And (Len(BinE$) < 32) Then VirgFlot = "<": Exit Function
  For I% = 1 To 150
    Fr# = 1 / (2 ^ I%)
    If PF# - Fr# >= 0 Then
      PF# = PF# - Fr#: BinF$ = BinF$ & "1"
    Else
      BinF$ = BinF$ & "0"
    End If
  Next
End If
VgF$ = BinE$ & BinF$
For DN% = DN% To 1 Step -1
  If Left$(VgF$, 1) = "1" Then Exit For
  VgF$ = Mid$(VgF$, 2)
Next
If Len(VgF$) > 24 Then
  VgF$ = Left$(VgF$, 24)
Else
  VgF$ = VgF$ & String$(24 - Len(VgF$), "0")
End If
VgF$ = Mid$(VgF$, 2)
BinE$ = DéciBin(Format$(DN%)): BinE$ = String$(8 - Len(BinE$), "0") & BinE$
VgF$ = S$ & BinE$ & VgF$
VirgFlot = VgF$
 
End Function
 
 
 
Private Function BinHexa(B$, Optional M% = 2) As String
Dim I%, K%, V%, H$, Hi$, Q$
 
Select Case B$
  Case "": H$ = "non valide"
  Case "<": H$ = "trop petit"
  Case Else
    For I% = 1 To 32 Step 4
      Q$ = Mid$(B$, I%, 4): V% = 0
      For K% = 1 To 4
        If Mid$(Q$, K%, 1) = "1" Then V% = V% + 2 ^ (4 - K%)
      Next
      H$ = H$ & Hex$(V%)
    Next
    If M% > 0 Then
      For I% = 1 To 8 Step 2
        Hi$ = Mid$(H$, I%, 2) & Hi$
      Next
    Else
      Hi$ = H$: M% = Abs(M%)
    End If
    H$ = ""
    Select Case M%
      Case 8: H$ = Hi$
      Case 4: H$ = Left$(Hi$, 4) & " " & Right$(Hi$, 4)
      Case Else
        For I% = 1 To 8 Step 2: H$ = H$ & Mid$(Hi$, I%, 2) & " ": Next
        H$ = RTrim$(H$)
    End Select
End Select
BinHexa = H$
 
End Function
 
Private Sub btConver_Click()
 
étHexa = vbCr & BinHexa(VirgFlot(txNbre), Val(caFormat.Tag) * IIf(caMode.Tag = "n", -1, 1))
 
End Sub
 
Private Sub btCopie_Click()
 
Clipboard.Clear: Clipboard.SetText txNbre & " >> " & Replace(étHexa, vbCr, "")
 
End Sub
 
Private Sub btRàz_Click()
 
txNbre = "": txNbre.SetFocus
 
End Sub
 
Private Sub coFormat_Click(Ind%)
 
caFormat.Tag = Mid$("842", Ind% + 1, 1)
 
End Sub
 
Private Sub coMode_Click(Ind%)
 
caMode.Tag = IIf(Ind% = 0, "n", "i")
 
End Sub
 
 
Private Sub txNbre_KeyPress(CdT%)
 
Select Case CdT%
  Case 8, Asc("0") To Asc("9"), Asc("-"), Asc("."), Asc(","), Asc("e"), Asc("e"), Asc(" ")
  Case Else: CdT% = 0
End Select
 
End Sub
 
 
 
Private Function DéciBin(Nb$) As String
Dim I%, V%, R%, T$, N$, B$
 
Do
  For I% = 1 To Len(Nb$)
    V% = Val(T$ & Mid$(Nb$, I%, 1)): R% = V% \ 2: N$ = N$ & Format$(R%): T$ = Format$(V% Mod 2)
  Next
  B$ = T$ & B$: Nb$ = IIf(Left$(N$, 1) = "0", Mid$(N$, 2), N$): N$ = "": T$ = ""
Loop Until Nb$ = ""
DéciBin = B$
 
End Function
 
Private Function EnForme(N$) As String
Dim NN$, I%, CS$, E%, V%
 
NN$ = Replace(N$, ",", "."): I% = InStr(NN$, ".")
If InStr(I% + 1, NN$, ".") > 0 Then
  Exit Function
End If
NN$ = Replace(NN$, " ", ""): I% = InStr(1, NN$, "e", vbTextCompare)
If I% > 0 Then
  CS$ = Left$(NN$, I% - 1): V% = InStr(CS$, "."): E% = Val(Mid$(NN$, I% + 1))
  If Abs(E%) > 45 Then Exit Function
  CS$ = String$(45, "0") & CS$ & IIf(V% > 0, "", ".") & String$(45, "0"): V% = InStr(CS$, ".")
  V% = V% + E%: CS$ = Replace(CS$, ".", ""): CS$ = Left$(CS$, V% - 1) & "." & Mid$(CS$, V%)
  Do While Left$(CS$, 1) = "0": CS$ = Mid$(CS$, 2): Loop
  Do While Right$(CS$, 1) = "0": CS$ = Left$(CS$, Len(CS$) - 1): Loop
  NN$ = CS$
Else
  If InStr(NN$, ".") = 0 Then NN$ = NN$ & "."
End If
EnForme = NN$
 
End Function
xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx

D} Commentaires périphériques
Voir les deux messages suivants.

Message du 22/09/2012, 10h30
 
D} Quelques commentaires périphériques

1) Trois expériences qui montrent que, si a = b et b = c, mieux vaut vérifier avant de conclure que a = c :

a} sachant que, dans VB, le plus grand entier positif stockable dans une variable de type Long est 2 147 483 647, on peut écrire
Dim L as Long, LL as Long, S as Single
L = 2147483647
S = 2147483647
' primo
Debug.Print L - S
' secundo
LL = S

Deux expériences pour le prix d'une :
primo >>> résultat : -1
secundo >>> on reçoit un message d'erreur Dépassement de capacité.

Surprenant, non ? non ! parce que, si on demande à voir le contenu de S, on obtient 2,147484E+09, soit 2 147 484 000, qui est effectivement supérieur à 2 147 483 647.
NB- on ne rencontre pas ce problème si on utilise, à la place de S, une variable en double précision.


b} prenons deux nombres entiers proches de la limite des variables en simple précision, et affectons-les à S1 et S2 :
Dim S1 as Single, S2 as Single
S1 = 340282200000000000000000000000000000000
S2 = 340282210000000000000000000000000000000
Debug.Print (S2 = S1)

N'importe quel observateur pas trop endormi notera entre les deux une différence de 10000000000000000000000000000000, soit 1e31 (dix mille milliards de millards de milliards) ; pour trouver une valeur équivalente, il faut se tourner vers l'astronomie : c'est cinq fois la masse du soleil exprimée en kilogrammes.

Allons-y. Réponse : Vrai ; ainsi, pour VB (comme pour tout système utilisant des nombres à virgule flottante sur quatre octets) 1e31 peut apparaître comme une quantité nulle (de même que, pour lui, 34028221! - 34028220! = 0).

c} avec la calculatrice de Windows cette fois.
En mode "scientifique", entrons la valeur décimale 123456789012345678901234567890, puis demandons-lui de la convertir en bits ; réponse : 11000011011100111110000011101110010011100011111100 00101011010010

Demandons alors la conversion de cette chaîne binaire en décimal ; réponse 14083847773837265618 ; ainsi, pour cet outil scientifique, 123456789012345678901234567890 = 14083847773837265618 ; il est clair que le premier nombre excède les capacités de la machine et qu'elle le réduit au second ; clair aussi que toute machine doit bien se fixer une limite ; ce qui est peut-être le plus inquiétant, c'est que rien ne soit prévu pour prévenir l'utilisateur de l'erreur qui l'attend (et qu'il n'attend sans doute pas).
d} cette troisième expérience malheureuse ne permettait pas de trouver la conclusion d'une quatrième : passer en argument à DéciBin un nombre de mille chiffres (1e999) ; la fonction renvoie bien (au bout de deux secondes) une chaîne de 3319 bits ; mais comment en vérifier l'exactitude ? peut-être en écrivant une fonction BinDéci pour accomplir le travail inverse en transformant une chaîne de 3319 bits en un entier décimal (de mille chiffres) ; mais comment vérifier l'exactitude de cette nouvelle fonction ? avec DéciBin ?


2) Deux fonctions

Pour boucler la boucle, on trouvera donc ci-dessous le code des deux fonctions DéciBin et BinDéci ; la première figurait déjà en B] et C], mais elle a été légèrement modifiée pour la raison indiquée plus loin en NB2.

NB1- pourquoi avoir refait ce que VB6 donne avec Hex$(N&) ou Val("&h" & H$) (la conversion hexadécimal<->binaire étant évidente) ? parce que ces deux fonctions posent le problème des limites : l'entier le plus grand qu'elles admettent est un nombre de 31 bits ; or le principe de la normalisation oblige à considérer des valeurs allant jusqu'à 127 bits (du moins vu la façon dont j'ai pu traiter la question, et même si, finalement, seuls les 24 bits de poids le plus fort sont pris en compte).

Les deux fonctions ci-dessous permettent de s'affranchir de cette limite, puisqu'elle travaillent sur une chaîne, caractère par caractère, donc indéfiniment en théorie ; mais en pratique ? la limite est bien sûr celle de la longueur de la chaîne, soit environ 2 milliards de caractères, selon l'aide de VB ; on a vu un peu plus haut la difficulté de se représenter un nombre comme 1e31 ; on peut quand même pousser jusqu'à 1e80, nombre (supposé) d'atomes de notre univers ; mais 1e2000000000 ?

Pour revenir à notre code,
a} on a limité la longueur du nombre à un Integer, donc 32767 chiffres ;
b} la limite en question s'applique aussi bien à la chaîne décimale qu'à la chaîne binaire ; or la longueur de cette dernière est, pour une valeur donnée, entre le triple et le quadruple de la première ; c'est donc elle qui doit être retenue et amène à considérer que le nombre décimal le plus grand est limité à environ 10 000 chiffres ;
c} pour aller au-delà, il faudrait
>>> remplacer les variables Integer I%, K%, Lg%, Mx% et Z% par des variables Long,
>>> pour les entrées et sorties, utiliser des zones de texte RTF en lieu et place de Textbox ;
>>> voir également le paragraphe consacré à T& dans les Addenda ;

NB2- pour créer une chaîne caractère par caractère, on dispose (au moins) de deux méthodes :
a} partant de Chaîne$ = "", boucler Chaîne$ = Chaîne$ & Caractère$ (ou Caractère$ & Chaîne$, selon le cas) ;
b} partant de Chaîne$ = Space$(longueur finale), boucler Mid$(Chaîne$, I%, 1) = Caractère$.
_ La première est bien sûr la plus naturelle ; mais elle devient de plus en plus lente à mesure que Chaîne$ grandit (expérience très concluante avec une fonction transformant un fichier Unicode en Ascii) ; à partir de quelle longueur la différence est-elle sensible ? je l'ignore ; mais puisque la limite théorique des deux fonctions est un nombre de quelque deux gigaocets de long, elles ont été modifiées dans le sens de la rapidité. Ainsi, il faut environ 35 secondes pour transformer un nombre de 4000 chiffres en une chaîne de 13 287 bits (voir plus bas dans les Addenda) et un peu moins d'une minute pour l'opération inverse.

Private Function DéciBin(Nb$) As String
'* transforme une chaîne de chiffres décimaux en chaîne de bits
Dim I%, Z%
Dim V%, R%, T$, N$, B$
 
Z% = Len(B$): B$ = Space$(Z% * 4) '<-- estimation (nb bits / nb chiffres) pour une valeur donnée
Do '<-- divisions successives par 2
  For I% = 1 To Len(Nb$) '<-- pour chaque chiffre
    V% = Val(T$ & Mid$(Nb$, I%, 1)): R% = V% \ 2: N$ = N$ & Format$(R%): T$ = Format$(V% Mod 2)
  Next '* ^- retenue précédente nouvelle retenue -^
  Z% = Z% - 1: Mid$(B$, Z%, 1) = T$: Nb$ = IIf(Left$(N$, 1) = "0", Mid$(N$, 2), N$): N$ = "": T$ = ""
Loop Until Nb$ = "" '* enlève le 0 de gauche s'il y a lieu --^^^
DéciBin = Trim$(B$)
 
End Function

Private Function BinDéci(B$) As String
'* transforme une chaîne de bits en chaîne de chiffres décimaux (partie entière)
Dim I%, K%, Lg%, Mx%
Dim D$, T&, R%, C$, T2$()
 
D$ = "1" '<-- valeur du bit considéré (puissance de 2), en chaîne de chiffres décimaux
'* remplit le tableau avec les puissances de 2 présentes dans B$
Lg% = Len(B$): ReDim T2$(Lg%): Mx% = 1
For I% = Lg% To 1 Step -1
'* place D$ dans T2$() si le bit est à 1
  If Mid$(B$, I%, 1) = "1" Then T2$(I%) = D$: Mx% = Len(D$) '<-- fixe le nombre de chiffres de la valeur la plus grande
  D$ = Mult2(D$): DoEvents '<-- valeur suivante
Next
'* justifie à droite les valeurs de T2$()
For I% = 0 To Lg%
  T2$(I%) = String$(Mx% - Len(T2$(I%)), "0") & T2$(I%) '<-- si bit à 0, T2$(I%) = "" >> remplacer par String$(Mx%, "0")
  DoEvents
Next
'* fait la somme des nombres de la liste
D$ = Space$(Mx% + 2) '<-- crée la chaîne à remplir
For K% = Mx% To 1 Step -1 '<-- pour chaque chiffre de droite à gauche
  For I% = 0 To Lg% '<-- pour chaque ligne
    T& = T& + Val(Mid$(T2$(I%), K%, 1))
  Next
  C$ = Format$(T& + R%): If Len(C$) > 1 Then R% = Val(Left$(C$, Len(C$) - 1)): C$ = Right$(C$, 1) Else R% = 0
  Mid$(D$, K%, 1) = C$: T& = 0: DoEvents
Next '* dernière retenue -v // cas de 0 ------v
D$ = IIf(R% > 0, Format(R%), "") & D$: If D$ = "" Then D$ = "0"
BinDéci = Trim$(D$)
 
End Function

Sous-fonction utilisée par BinDéci :
Private Function Mult2(N$) As String
'* équivaut à Format$(Val(N$) * 2)
Dim I%, Dbl$, R%, C$
 
For I% = Len(N$) To 1 Step -1
  C$ = Format$(Val(Mid$(N$, I%, 1)) * 2 + R%)
  If Len(C$) = 2 Then R% = 1: C$ = Right$(C$, 1) Else R% = 0
  Dbl$ = C$ & Dbl$
Next
Mult2 = IIf(R% = 1, "1", "") & Dbl$
 
End Function
3) Addenda

aaa voir le message suivant.


Message du 22/09/2012, 10h46

Ia ora na.

3) Addenda


    a} encore deux exemples de limites imprévues, dans la fonction BinDéci :
    >>> pour stocker les valeurs successives des puissances de 2, elle utilisait initialement une liste (ListBox) au lieu du tableau T2$() ; et tout allait bien pour un décimal comprenant jusqu'à un millier de chiffres ; mais le résultat devenait aberrant au-delà ; il a fallu quelques tâtonnements pour trouver qu'une liste n'enregistre que 1024 caractères par ligne, et tronque sans barguigner (ni prévenir) au-delà ;
    >>> la variable T& : c'est la valeur obtenue en faisant la somme de tous les chiffres de même rang (= d'une même colonne, si les nombres sont justifiés à droite) de tous les équivalents décimaux des différentes puissances de 2 (enregistrés dans le tableau T2$) ; la version initiale de la fonction utilisait une variable T% ; sa limite théorique correspondait donc à une entrée de 3640 bits (à supposer que tous les chiffres à additionner soient des 9 et que le nombre binaire ne soit composé que de 1) ; or le plus grand nombre testé dépasse les treize mille bits ; pas de problème pour 1e3999, mais dépassement de capacité pour le nombre présenté ci-dessous en b} ; T& repousse la limite (toujours aussi théorique) à un nombre composé de 238 609 294 bits ; au-delà, rien n'interdirait d'envisager une variable de type Currency, ou même Decimal ;

    b} pour le nombre décimal composé de quatre mille chiffres 3, la fonction DéciBin renvoie
    10001011110100011010110011000010101010011000111001011101100101100
    00010001110100001010111000101110000010001000000110111110111111100
    10110000111000111001010110110010110010111000110101111110100101010
    11011011101011011000010010000100010000101111110011001011011001001
    11110110010110011010101011000001100100010000000000100001011011101
    11101000110100011111001011110000110111011111111101110111000000101
    11010101101111110001100101011000111110111101001101110010010100011
    10011100011101101110111111100100000100101110001101101011111010101
    11110010001101110011101110010011100010101001101000001101011101101
    10110111111011000000101101110111111001101001010101011101101111111
    01010110111101100100110000010111111001100100000011001000101100011
    11001100100001010001100101001110101000000110100111100100000001111
    01010011110110010011000110000001000101110001110101111010110010011
    10111001010101010010011100000100110110001111101010110011001011001
    00000011101001110011010101111110111000000010000000001000100011010
    01110011000100001010011100110010010101111001011100110111100010000
    01100100110101101111111001111000111011000011101010100100111101111
    01011100110000010111110100000111101101101111101010011000001110100
    00110110011011000101111011111101011011110000100001001100101000111
    01111101011000011011110101010111010000010111101001001101101100010
    10110011100100111100000100111100001011011000001001100100010110100
    01100000110101111111010101100100110101101000000111101000100100111
    01111010010100110010011110110111110111001110110100011010010010101
    01100111011011001011011011010111111011011000010101010011010100110
    01110100011001011000000111001111101011111010010010101000010011101
    01000001011111101100101110011101000100011111000000111111010010010
    01001001101011011000110011001111011011011011010110001001010110000
    10000101011111011100000111010011001110001111000111100010010100100
    10011100101011010001101011010011011001001010011100111000110111100
    11001011001000011111010000000110010101100011111100101010001001111
    10110010111111011011000010010110001001010001111101001010011011101
    10000011010110010001101010011111101011111110100100110001101111100
    11010100010101010001001000010101011110010010101010000100111001111
    11010010100011001100001110111100000111001100010110000011101101101
    10011010011001010000111111000010110011001101000111001010001100000
    00101101000001000100001110111000000110000101100101011110101111100
    00001110011110010111010101100100010101000111110001100000100010001
    10001000001011001100010001101101111001000100001110011001011000011
    01100111100001110011101101001000111001000111110110111111001101001
    10010110011110011011010011010100011101000001110001110001111001101
    11011100100110010000100011001011011101111110001110111111110001000
    00000111001000000111010100100100101101001000101100110110110011001
    00011001011010010101111111100101001011000111011101000100110100001
    11110111010010011011111100110111111101011110100001001110001001100
    00011111000111110100100010010000010100101111011010110110100101100
    01000110000001010111010010111100000110000111111011101110100000111
    01011101111000101111010101001011010001000001011011100001010000110
    00011001110001010100011011111110111000000101011101010110000001101
    11100110001111000001111111110011011000101001110001101000110100010
    11110011011100101100011101011011000000010100010101010111000011110
    11001001101011100101100110011001100001101000110010001001011110101
    11111101001001001011000011010000010001000110010011101101001110110
    11011101010111010010101001101010011001001011111110011011010001001
    01101011010011100010001101100101100001101101111111011010010000000
    11111110010011010011111110110001100010110111101000000110000001010
    10110110011001010011000000100101011010000010100011000110101010001
    10100010011101000100111000111110011110110110100100101101001010101
    11101001010111000100000010001100000100011111000101011000010111100
    01111100100110110000111011000000001000000001010000010011100111010
    10000000000011111101011010100111110101001100011011100111100000011
    01111001110100101100000001000010100100010010100010001011000011010
    01111110011011001011100010100111010111110111100110101010000101110
    01101011110100011010101000111010100010111000111001111100011001100
    00000010101000111110101010111100101101111000010111110001010000001
    01110110100000111101110101111001001011000010100100011011010100011
    01101001101001111101011000000001010110010001001101111010100111111
    01010000110010110101001001101100001011000101111011110110010010010
    10110101001110001000001011101110100111100100001111010111111010011
    01011001110000000001110111100111110110101011111011000101000000011
    01011110111011111111010101000111101110011100001110100000001101010
    01111111011001001111110000111100111011010111100101001001011100001
    10110000110000110001100011001101000101010000110000011101100110000
    10101010111101011001101010011001100100111001010111110010101010110
    01111111000111000110101000000001110000011000000010100000111110111
    01001001010001001010001001110111111000000000111110011000110100011
    10010111011101110010110001011000000000111111100001111001001000011
    11011100011110001000000010101110010001100101111110000101101011100
    00101110010000110110011011101001001010010111101000100010000100111
    11010011101101010111011100110101000001000101010010001011000101111
    00001111100100001000101011011111001001010000011000100101100100101
    01100100000110111100111101010000100011010100000111110010100010000
    01100010111000100101011101011100001011011111110110010010111011110
    00000001010100000010111111101010010101011111101001001101100110100
    01001101110100101010110000010101101101100111001001011101110010011
    10011001010011011100101110011001010101111010101110010001011101111
    00111100110010110000100000101110010011000111100011010101111001111
    10000011000000010000001010001000010011100010001100100111101010011
    11101111110011011000100010101011110000100000110101010110010000111
    01111010010100100001101010110011111001110001100101110001001000000
    00010111000101001010100100010100101111111110001101111111000010110
    10110010101111111100010101001110111000011011100110000011101000101
    11111001111100101010001000100000000110100100001001110010101010011
    11000011001101101110100010100001010111011000111011001111101111100
    11111010110100010011010001001011000001000001001110000001010111001
    00010010000001000101011001110011101000000000111000100011111001101
    01100111001010100011111011110111111101011011110010101000011010101
    00101111000001101000110110011000011001000100010100011101011111111
    10001000110100111010011100011001110110010110111000100001000101010
    00111000111011010111100110000000000010100000101100100001001101101
    00111111010010011100111001111110101010110011000000000100011010001
    10000110110110011000111111110000011001111001000000110110100101110
    00010010001111111100110100010101001001000001001011010101010000110
    01110101011100000110101101000100010101100000001011001100101010000
    00110110100010111000111010010110000011101001010000001001110001010
    10110011111001110010011010000101111110011000101010011001110010010
    10011100101000111100010010000101100100100101001100001100010110101
    01100011100110100011011011010010101010111000010111100111011000101
    01101101100111010011000000111110101110001110011010001010011111101
    10100100101110010011001110101110111000110111000100100000110000001
    11110010000110101111001001110000111001010111110010001101111000011
    01100010110101001000101100100100111101011010010111011101111010110
    00111011010011011011101111110110100110110000111110111010011110000
    11010011000000011111101010011101100001000110011000111010000110111
    01111100001101010110010100010110000011111011110110000110100000111
    11111110000111101010100001000111111101001011010001011010010011001
    01100111101110110001011001100111011101111010111011011010100000100
    10101111011000001011100111000111111111100001010010101111110101010
    01001110111011011101111011111101010001000010111111001101110100111
    00101000000111001101101011000010011101001010100001001100101001001
    11110111110110010110101101010010011010110110010110001101101001000
    10111101010101110001111000111000100110010010001000101110010101111
    00000011100011101001100111001011111100111101100000110110001111000
    00011100000110100010001001110111100011101011111000010110000011111
    00010000110010011010110000010011101100111101010100111001000111010
    00001010001100001111011000011111000100001100100011010010100101111
    11100001110001011111001111011110110001011010111011100011010011101
    10100001010110000110011100000000111010010011000000010001010111001
    11110000100000010001101011001101001010110001111101111111101110011
    11111011001101011010001001001110101100011100001111010101110010100
    00000111010111100011111011000110100101001000110100110100011001101
    01101010010110110110011100010011101111000010100111000011100000110
    10101111100110011110111011110111111000110100011000110000110010101
    00011100100011100000110011001111011011010100100011100110100101110
    10011000001110011011010001101100101100000001011000010001110010111
    10100110110100000000011000010000011011001111110110111101000000000
    11010011100111110100001001010001111001101110010110000000010110010
    01010011000010110100010110100111110011101101011111111011111111100
    10100101101101110000110000011001111110101000011110101110111111001
    10111100100100101011000110101000001110001010111011010001001111000
    00110111101011111110110111010001011000110110101001011111001101011
    01100010000111101100101000110101010010010000010101000111001001110
    10110010100011111101001001111100011100101111001010001010111000000
    10000010010001001001111101011100011100000110100001000000001010101
    01010101010101010101010101010101010101010101010101010101010101010
    10101010101010101010101010101010101010101010101010101010101010101
    01010101010101010101010101010101010101010101010101010101010101010
    10101010101010101010101010101010101010101010101010101010101010101
    01010101010101010101010101010101010101010101010101010101010101010
    10101010101010101010101010101010101010101010101010101010101010101
    01010101010101010101010101010101010101010101010101010101010101010
    10101010101010101010101010101010101010101010101010101010101010101
    01010101010101010101010101010101010101010101010101010101010101010
    10101010101010101010101010101010101010101010101010101010101010101
    01010101010101010101010101010101010101010101010101010101010101010
    10101010101010101010101010101010101010101010101010101010101010101
    01010101010101010101010101010101010101010101010101010101010101010
    10101010101010101010101010101010101010101010101010101010101010101
    01010101010101010101010101010101010101010101010101010101010101010
    10101010101010101010101010101010101010101010101010101010101010101
    01010101010101010101010101010101010101010101010101010101010101010
    10101010101010101010101010101010101010101010101010101010101010101
    01010101010101010101010101010101010101010101010101010101010101010
    10101010101010101010101010101010101010101010101010101010101010101
    01010101010101010101010101010101010101010101010101010101010101010
    10101010101010101010101010101010101010101010101010101010101010101
    01010101010101010101010101010101010101010101010101010101010101010
    10101010101010101010101010101010101010101010101010101010101010101
    01010101010101010101010101010101010101010101010101010101010101010
    10101010101010101010101010101010101010101010101010101010101010101
    01010101010101010101010101010101010101010101010101010101010101010
    10101010101010101010101010101010101010101010101010101010101010101
    01010101010101010101010101010101010101010101010101010101010101010
    10101010101010101010101010101010101010101010101010101010101010101
    01010101010101010101010101010101010101010101010101010101010101010
    10101010101010101010101010101010101010101010101010101010101010101
    01010101010101010101010101010101010101010101010101010101010101010
    10101010101010101010101010101010101010101010101010101010101010101
    01010101010101010101010101010101010101010101010101010101010101010
    10101010101010101010101010101010101010101010101010101010101010101
    01010101010101010101010101010101010101010101010101010101010101010
    10101010101010101010101010101010101010101010101010101010101010101
    01010101010101010101010101010101010101010101010101010101010101010
    10101010101010101010101010101010101010101010101010101010101010101
    01010101010101010101010101010101010101010101010101010101010101010
    10101010101010101010101010101010101010101010101010101010101010101
    01010101010101010101010101010101010101010101010101010101010101010
    10101010101010101010101010101010101010101010101010101010101010101
    01010101010101010101010101010101010101010101010101010101010101010
    10101010101010101010101010101010101010101010101010101010101010101
    01010101010101010101010101010101010101010101010101010101010101010
    10101010101010101010101010101010101010101010101010101010101010101
    01010101010101010101010101010101010101010101010101010101010101010
    10101010101010101010101010101010101010101010101010101010101010101
    01010101010101010101010101010101010101010101010101010101010101010
    10101010101010101010101010101010101010101010101010101010101010101
    01010101010101010101010101010101010101010101010101010101010101010
    10101010101010101010101010101010101010101010101010101010101010101
    01010101010101010101010101010101010101010101010101010101010101010
    10101010101010101010101010101010101010101010101010101010101010101
    01010101010101010101010101010101010101010101010101010101010101010
    10101010101010101010101010101010101010101010101010101010101010101
    01010101010101010101010101010101010101010101010101010101010101010
    10101010101010101010101010101010101010101010101010101010101010101
    01010101010101010101010101010101010101010101010101010101010101010
    101010101010101010101010101

et vice-versa.
    NB- le nombre binaire ci-dessus a dû être coupé en lignes de 64 bits pour ne pas perturber l'éditeur ; pour l'utiliser par copier-coller, il faudrait supprimer les sauts de ligne (chr$(13) & chr$(10)).


Bon vent à toutes et à tous.


Dernière édition par XylonAkau ; 04/09/2013 à 20h24. Raison: Mise aux nouvelles normes

Message du 18/08/2013, 08h08

Ia ora na.

Parce qu'on n'arrête pas le progrès, même lorsqu'il va à tout petit pas, voici une version améliorée de DéciBin et de BinDéci :

    Private Function DéciBin(Nb$) As String
    Dim I&, Z&
    Dim V%, R%, T$, N$, B$
     
    B$ = Space$(Len(Nb$) * 4): Z& = Len(B$)
    Do
        For I& = 1 To Len(Nb$)
            V% = Val(T$ & Mid$(Nb$, I&, 1)): R% = V% \ 2: N$ = N$ & Format$(R%): T$ = Format$(V% Mod 2)
            DoEvents: If Halte Then Exit Function
        Next
        Z& = Z& - 1: Mid$(B$, Z&, 1) = T$: Nb$ = IIf(Left$(N$, 1) = "0", Mid$(N$, 2), N$): N$ = "": T$ = ""
        étTpsDB = Format$(Len(Nb$)): étTpsDB.Refresh: DoEvents
    Loop Until Nb$ = ""
    DéciBin = Trim$(B$)
     
    End Function

    Private Function BinDéci(B$) As String
    '* transforme une chaîne de bits en chaîne de chiffres décimaux (partie entière)
    Dim D$, K&, Lg&, TT$, I&, R%, T%
     
    Lg& = Len(B$): TT$ = "0": D$ = "1"
    For K& = Lg& To 1 Step -1 '<-- pour chaque chiffre binaire de droite à gauche
        If Mid$(B$, K&, 1) = "1" Then '<-- si bit = 1, ajoute D$ à TT$
            Do While Len(TT$) < Len(D$) '<-- fait que Len(TT$) = Len(D$)
                TT$ = "0" & TT$: GoTo Bcle
            End If
            R% = 0
            For I& = Len(D$) To 1 Step -1 '<-- pour chaque chiffre
                '* additionne puissance de 2, total actuel et retenue
                T% = Val(Mid$(TT$, I&, 1)) + Val(Mid$(D$, I&, 1)) + R%
                '* met en place le chiffre des "unités" et fixe la retenue
                Mid$(TT$, I&, 1) = Right$(Format$(T%), 1): R% = IIf(T% > 9, 1, 0): DoEvents: If Halte Then Close: Exit Function
                If I& = 1 Then '<-- test sur deux "if" pour ne pas tester R% pour rien
                    If R% = 1 Then '<-- dernière retenue
                        TT$ = "1" & TT$
                    End If
                End If
            Next
        End If
        D$ = Mult2(D$) '<-- puissance de 2 suivante
        étTpsBD = Format$(K&): étTpsBD.Refresh: DoEvents: If Halte Then Close: Exit Function
    Next
    BinDéci = TT$
     
    End Function
    NB1- Halte est une variable booléenne mise à Vrai quand on clique sur un bouton [Annuler]. Cela peut toujours servir quand il faut environ trois heures et demie pour convertir un nombre décimal de 40 000 chiffres en un nombre binaire de 132 880 chiffres (ou l'inverse).
    NB2- les deux fonctions devraient aller jusqu'à la longueur maximale d'une chaîne en VB6, soit un peu plus de deux millions de caractères pour le nombre binaire ; à moins que l'espace-mémoire ne se trouve saturé avant.

Bonne semaine à toutes et à tous.


Plan du site & Mentions légales_._Site éclos sur Skyrock, développé avec Axiatel et mûri sur Strato.com_._© 2015-2024 - XylonAkau