How to convert from integer/long integer to binary ?

[dev]

How to convert from integer or long integer to binary in Visual Basic,
for example : 9568 to 10010101100000
and how to convert back from binary to integer or long integer,
for example : 10010101100000 to 9568.

Please help.
dev.

[cksiow]

as VB doesn't support binary string, so I assume the binary is in string variable. if this is the case, try http://vblib.virtualave.net, there is 2 functions, Dec2Bin & Bin2Dec in vbConversion of the activeX DLL which might help.


HTH

cksiow
http://vblib.virtualave.net - share our codes

[Iouri]

Here's a function that will convert any decimal number less than 256 to binary:

Function Decimal2Binary(TheNumber As Integer) As String
Dim TheBinaryNumber As String
Dim ThePosition As Integer
Dim iWork As Integer
TheBinaryNumber = "00000000"
If TheNumber < 256 Then
ThePosition = 128
For iWork = 1 To 8
If TheNumber >= ThePosition Then
Mid$(TheBinaryNumber, iWork, 1) = "1"
TheNumber = TheNumber - ThePosition
End If
ThePosition = ThePosition / 2
Next
End If
Decimal2Binary = TheBinaryNumber
End Function



Iouri Boutchkine
iouri@hotsheet.com

[Iouri]

'Binary to Decimal

Function BinToDec(value As String) As Long
Dim result As Long, i As Integer, exponent As Integer
For i = Len(value) To 1 Step -1
Select Case Asc(Mid$(value, i, 1))
Case 48 ' "0", do nothing
Case 49 ' "1", add the corresponding power of 2
result = result Or Power2(exponent)
Case Else
Err.Raise 5 ' Invalid procedure call or argument
End Select
exponent = exponent + 1
Next
BinToDec = result
End Function

Function Power2(ByVal exponent As Long) As Long
Static res(0 To 31) As Long
Dim i As Long

' rule out errors
If exponent < 0 Or exponent > 31 Then Err.Raise 5

' initialize the array at the first call
If res(0) = 0 Then
res(0) = 1
For i = 1 To 30
res(i) = res(i - 1) * 2
Next
' this is a special case
res(31) = &H80000000
End If

' return the result
Power2 = res(exponent)

End Function




Iouri Boutchkine
iouri@hotsheet.com

[Iouri]

Here is another clue (any decimal to binary)

Private Sub Form_Load()
txtDecimalValue.Text = "123456789"
End Sub

Private Sub txtDecimalValue_KeyPress(KeyAscii As Integer)
'Cancel input if the key pressed is not a number
If IsNumeric(Chr(KeyAscii)) = False Then
KeyAscii = 0
End If
End Sub
Function Bin(Number) ' both Variants
' #Binary BITS# by Chris
' based on the Two's-Complement "shortcut" method
'===========================================
Dim BitStream() As Byte
Dim Bits As Byte
Dim BitPointer As Byte
Dim HexString As String
Dim lenHS As Integer
Dim HalfByte As Byte ' smallest VB word
Dim i As Integer
Dim j As Integer

Const DABug As Boolean = False
On Error GoTo eror

Select Case VarType(Number)
Case vbNull
'pass a null, return a null
Bin = Number
Exit Function
Case vbByte
' 0 to 255 unsigned
Bits = 8
Case vbInteger, vbBoolean
' -32,768 to 32,767
Bits = 16
Case vbLong
' -2,147,483,648 to 2,147,483,647
Bits = 32
Case vbSingle, vbDouble
Bits = 32
' HEX() will convert these
' to Longs (if possible!)
Case vbString
'-a Number of unspecified Type-
''Note: This expects a String to be a Number
'' To get the bits for a String, try this code:
''Dim BS() As Byte
''BS = MyString '-or- BS = StrConv(MyString, vbFromUnicode)
''For i = LBound(BS) To UBound(BS)
'' Print Bin(BS(i)),
''Next i
Case Else
Err.Raise 2001, , "Not sure HOW to handle a (" & TypeName(Number) & ") DATA TYPE?"
End Select

'' if HEX() can't handle it,
'' then neither can this code!
HexString = Hex(Number)
lenHS = Len(HexString)

If Bits = 0 Then Bits = lenHS * 4 'bits
ReDim BitStream(1 To Bits)
BitPointer = Bits

For i = lenHS To 1 Step -1
HalfByte = Val("&H" & Mid(HexString, i, 1))
For j = 1 To 4 ' bits
If HalfByte Then
BitStream(BitPointer) = HalfByte Mod 2
HalfByte = Fix(HalfByte / 2)
End If
BitPointer = BitPointer - 1
Next j
Next i

'now add 48 to all bits(bytes) for "0" or "1"
For i = 1 To Bits
BitStream(i) = BitStream(i) + 48
Next i

Bin = StrConv(BitStream, vbUnicode)
' format it
Bin = Trim(Format(Bin, "&&&&&&&& &&&&&&&& &&&&&&&& &&&&&&&&"))
'(format it here? or outside this proc?)
Exit Function

eror:
If DABug Then Debug.Print Err.Number & "-" & Err.Description
Err.Clear
Bin = "0"
End Function

Private Sub txtDecimalValue_Change()
lblBinaryValue.Caption = Bin(txtDecimalValue.Text)
End Sub




Iouri Boutchkine
iouri@hotsheet.com