VALEUR BINAIRE SANS CALCULS
Bricomix
Messages postés
340
Date d'inscription
vendredi 11 octobre 2002
Statut
Membre
Dernière intervention
14 février 2005
-
3 août 2003 à 11:07
cs_Warning Messages postés 516 Date d'inscription samedi 3 février 2001 Statut Membre Dernière intervention 24 octobre 2006 - 7 sept. 2003 à 14:32
cs_Warning Messages postés 516 Date d'inscription samedi 3 février 2001 Statut Membre Dernière intervention 24 octobre 2006 - 7 sept. 2003 à 14:32
Cette discussion concerne un article du site. Pour la consulter dans son contexte d'origine, cliquez sur le lien ci-dessous.
https://codes-sources.commentcamarche.net/source/8130-valeur-binaire-sans-calculs
https://codes-sources.commentcamarche.net/source/8130-valeur-binaire-sans-calculs
7 sept. 2003 à 14:32
6 sept. 2003 à 19:20
Function ValToBinString(ByVal Vl As Byte) As String
For i = 0 To 7
c = Vl Mod 2
If c > 0 Then
c = 1
Vl = (Vl - 1) / 2
Else
Vl = Vl / 2
End If
ValToBinString = ValToBinString & c
Next i
End Function
mouais, non, ya pas photo... bon sang mais qu'est-ce que t'avais bouffé ??? :D
6 sept. 2003 à 18:43
Public Function Bin(ValDec As Long) As String
Dim MVal As Double, BinLen As Long, BclLen As Double, i As Long
MVal = 0.5
BinLen = 1
BclLen = ValDec
While BclLen > 15
BinLen = BinLen + 1
BclLen = Sqr(BclLen)
Wend
For i = 1 To BinLen
MVal = MVal * 2
Bin = Fix(Val(ValDec) / (8 * (MVal ^ 4))) Mod 2 & Fix(Val(ValDec) / (4 * (MVal ^ 4))) Mod 2 & Fix(Val(ValDec) / (2 * (MVal ^ 4))) Mod 2 & Fix(Val(ValDec) / (MVal ^ 4)) Mod 2 & Bin
Next i
End Function
C completement idiot et je sais meme pas comment j'ai pu arrivé à ce résultat ...(avec des 0.5 lol) :P bref, c'est tout aussi bidon... On fait un concour??? :D
lol @++,Warning
3 août 2003 à 22:28
je persiste et signe a dire que cette source est bidon, car ya déjà 73 façons différente de convertir un ENTIER en BINAIRE sur ce site, mais j'en ai pas vu qui fassent DECIMALE vers BINAIRE (type single ou double avec mantisse et exposant)...
Qui plus est, c'est lent car ca fait de la manipulation de chaine de caractères à chaque ligne (m'enfin ca l'est moins que de la concaténation, je vous l'accorde)
3 août 2003 à 21:24
Pour corriger l'erreur, change cette ligne:
Mid(IntToBin, 1, 1) = Abs((IntVal And &H8000) > 0)
par cette ligne:
Mid(IntToBin, 1, 1) = Abs((IntVal And &H8000) < 0)
Il y a une autre façon aussi rapide mais plus facile à comprendre:
Function IntToBin(IntVal As Long) As String
IntToBin = Hex(IntVal) 'Hex permet 32 bits max (type Long)
IntToBin = Replace(IntToBin, "0", "0000")
IntToBin = Replace(IntToBin, "1", "0001")
IntToBin = Replace(IntToBin, "2", "0010")
IntToBin = Replace(IntToBin, "3", "0011")
IntToBin = Replace(IntToBin, "4", "0100")
IntToBin = Replace(IntToBin, "5", "0101")
IntToBin = Replace(IntToBin, "6", "0110")
IntToBin = Replace(IntToBin, "7", "0111")
IntToBin = Replace(IntToBin, "8", "1000")
IntToBin = Replace(IntToBin, "9", "1001")
IntToBin = Replace(IntToBin, "A", "1010")
IntToBin = Replace(IntToBin, "B", "1011")
IntToBin = Replace(IntToBin, "C", "1100")
IntToBin = Replace(IntToBin, "D", "1101")
IntToBin = Replace(IntToBin, "E", "1110")
IntToBin = Replace(IntToBin, "F", "1111")
End Function
Tu remarquera ceci: IntVal As Long
Ca te permet des nombres signés de 32 bits (4 octets) dont la valeur est comprise entre -2 147 483 648 et 2 147 483 647.
3 août 2003 à 12:26
3 août 2003 à 11:07
9/10