Valeur binaire sans calculs

Soyez le premier à donner votre avis sur cette source.

Snippet vu 6 542 fois - Téléchargée 36 fois

Contenu du snippet

converti une valeur en string binaire, sans opérations mathématiques.
vive le masque de bits :)

Source / Exemple :


DefInt A-Z

Function IntToBin(IntVal As Integer) As String
'valeur binaire d'un entier 16-bits par bit-masking
    IntToBin = Space$(16)
    Mid(IntToBin, 1, 1) = Abs((IntVal And &H8000) > 0)
    Mid(IntToBin, 2, 1) = Abs((IntVal And &H4000) > 0)
    Mid(IntToBin, 3, 1) = Abs((IntVal And &H2000) > 0)
    Mid(IntToBin, 4, 1) = Abs((IntVal And &H1000) > 0)
    Mid(IntToBin, 5, 1) = Abs((IntVal And &H800) > 0)
    Mid(IntToBin, 6, 1) = Abs((IntVal And &H400) > 0)
    Mid(IntToBin, 7, 1) = Abs((IntVal And &H200) > 0)
    Mid(IntToBin, 8, 1) = Abs((IntVal And &H100) > 0)
    Mid(IntToBin, 9, 1) = Abs((IntVal And &H80) > 0)
    Mid(IntToBin, 10, 1) = Abs((IntVal And &H40) > 0)
    Mid(IntToBin, 11, 1) = Abs((IntVal And &H20) > 0)
    Mid(IntToBin, 12, 1) = Abs((IntVal And &H10) > 0)
    Mid(IntToBin, 13, 1) = Abs((IntVal And 8) > 0)
    Mid(IntToBin, 14, 1) = Abs((IntVal And 4) > 0)
    Mid(IntToBin, 15, 1) = Abs((IntVal And 2) > 0)
    Mid(IntToBin, 16, 1) = Abs((IntVal And 1) > 0)
End Function

'ya volontairement pas de for....next, car c'est bcp plus rapide asm parlant via cette ecriture directe.

Conclusion :


...
heu, faut que j'arrete avec les sources bidons...

A voir également

Ajouter un commentaire

Commentaires

cs_Warning
Messages postés
517
Date d'inscription
samedi 3 février 2001
Statut
Modérateur
Dernière intervention
24 octobre 2006
1 -
bah en plus ya un tit pb dans ma source... par exemple il convertit 65536 en 00000000.... no comment :P
Proger
Messages postés
248
Date d'inscription
vendredi 10 novembre 2000
Statut
Membre
Dernière intervention
19 décembre 2008
-
ouh! la vache... t'as avalé quoi ce jour là ? :) hébé... attend voir, j'ai ça dans mes vieilles sources :
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
cs_Warning
Messages postés
517
Date d'inscription
samedi 3 février 2001
Statut
Modérateur
Dernière intervention
24 octobre 2006
1 -
lol, vous voulez voir la routine de conversion que j'ai faite pour mes prog?

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
Proger
Messages postés
248
Date d'inscription
vendredi 10 novembre 2000
Statut
Membre
Dernière intervention
19 décembre 2008
-
ok boursicotteur, bonne remarque. En fait y'a plus général encore, et on se débarasse du test : Mid(IntToBin, 1, 1) = Abs(CBool(IntVal And &H8000))

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)
boursicotteur
Messages postés
201
Date d'inscription
mercredi 25 septembre 2002
Statut
Membre
Dernière intervention
10 novembre 2007
-
Il y a une erreur dans ta fonction qui fait que les nombres négatifs sont convertis incorrectement en binaire.

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.

Vous n'êtes pas encore membre ?

inscrivez-vous, c'est gratuit et ça prend moins d'une minute !

Les membres obtiennent plus de réponses que les utilisateurs anonymes.

Le fait d'être membre vous permet d'avoir un suivi détaillé de vos demandes et codes sources.

Le fait d'être membre vous permet d'avoir des options supplémentaires.