Printable View
Is there any routine that can translate a number (0-255) to a bitmap 0101010110?
For example, I would like that if the number is 3, then when I call the function, I get the result 00000011 somehow, or if the number is 255, then I get 11111111.
I know I can calculate it myself by dividing by 2 until finished,, but I am just wondering if I could get a bitmap by calling the function in VB instead.
Thanks
To code/decode binary numbers:
Code:Private Function Bin(ByVal intDec As Integer) As String
Dim strDummy As String
Dim intLess As Integer
Dim lngVal As Long
Dim strTrue As String
Dim strFalse As String
lngVal = intDec
intLess = 16384
If Abs(lngVal) = lngVal Then
strTrue = "1"
strFalse = "0"
strDummy = "0"
Else
strTrue = "0"
strFalse = "1"
strDummy = "1"
lngVal = Abs(lngVal) - 1
End If
Do
If lngVal - intLess >= 0 Then
strDummy = strDummy & strTrue
lngVal = lngVal - intLess
Else
strDummy = strDummy & strFalse
End If
intLess = intLess / 2
Loop While intLess >= 1
Bin = strDummy
End Function
Private Function Dec(strBin) As Integer
Dim intLess As Integer
Dim lngDummy As Long
Dim strDummy As String
Dim i As Integer
strDummy = strBin
intLess = 16384
If Left(strDummy, 1) = "0" Then
For i = 2 To 16
If Mid(strDummy, i, 1) = "1" Then
lngDummy = lngDummy + intLess
End If
intLess = intLess / 2
Next i
lngDummy = lngDummy
Else
For i = 2 To 16
If Mid(strDummy, i, 1) = "0" Then
lngDummy = lngDummy + intLess
End If
intLess = intLess / 2
Next i
lngDummy = (lngDummy * -1) - 1
End If
Dec = CInt(lngDummy)
End Function
Private Function ToBin(Text As String)
Dim endstr As String, xtra As String, i As Integer, i2 As Integer
endstr$ = ""
DoEvents
For i = 1 To Len(Text)
xtra$ = Bin(Asc(Mid$(Text, i, 1)))
For i2 = 1 To 8 - Len(xtra$)
xtra$ = "0" & xtra$
Next i2
Do While Len(xtra$) > 8
xtra$ = Mid$(xtra$, 2, Len(xtra$) - 1)
Loop
endstr$ = endstr$ & xtra$
DoEvents
If DoCancel = True Then Exit Function
Next i
ToBin = endstr$
End Function
Private Function ToDec(Text As String)
Dim endstr As String, xtra As String, xtra2 As Integer, xtra3 As String, i As Single
endstr$ = ""
CH:
If Not Int(Len(Text) / 8) = Len(Text) / 8 Then
Text = Mid$(Text, 1, Len(Text) - 1)
GoTo CH
End If
For i = 1 To Len(Text)
xtra$ = Mid$(Text, i, 1)
If Not xtra$ = "1" Then
If Not xtra$ = "0" Then
Exit Function
End If
End If
Next i
For i = 0 To (Len(Text) / 8) - 1
xtra3$ = Mid(Text, (i * 8) + 1, 8)
xtra2 = Dec("00000000" & xtra3$)
xtra$ = Chr$(xtra2)
endstr$ = endstr$ & xtra$
DoEvents
If DoCancel = True Then Exit Function
Next i
ToDec = endstr$
End Function
Usage
Private Sub Command1_Click()
MsgBox ToBin(3)
MsgBox ToBin(255)
End Sub
Thanks on replies. I had the code below which worked too and seemed simplier than the one Matthew posted.
But I guess the answer is: "No, there is no function available in VB, you have to code it yourself".
Cheers
Sandra
Dim Value1 As Integer
Dim Value1b As Integer
Dim Value2b As Integer
Dim Value3b As Integer
Dim Value4b As Integer
Dim Value5b As Integer
Dim Value6b As Integer
Dim Value7b As Integer
Dim Value8b As Integer
Dim b(0 to 7) As Integer
Dim bitovi As String
Value1 = Inp(&H379)
' Translate it to binary
Value1b = Int(Value1 / 2)
b(0) = Value1 - Value1b * 2
Value2b = Int(Value1b / 2)
b(1) = Value1b - Value2b * 2
Value3b = Int(Value2b / 2)
b(2) = Value2b - Value3b * 2
Value4b = Int(Value3b / 2)
b(3) = Value3b - Value4b * 2
Value5b = Int(Value4b / 2)
b(4) = Value4b - Value5b * 2
Value6b = Int(Value5b / 2)
b(5) = Value5b - Value6b * 2
Value7b = Int(Value6b / 2)
b(6) = Value6b - Value7b * 2
Value8b = Int(Value7b / 2)
b(7) = Value7b - Value8b * 2
'binary string
bitovi = b(0) & b(1) & b(2) & b(3) & b(4) & b(5) & b(6) & b(7)
Correct. I don't believe there is a function in VB. You must make your own function :rolleyes:.
:/
:x
:8
:q
:O
:|
:S
Nope. I've flipped the ENTIRE MSDN library over and still no.