by J.Edwards (2 Submissions)
Category: Math/Dates
Compatability: Visual Basic 5.0
Difficulty: Unknown Difficulty
Originally Published: Fri 8th September 2000
Date Added: Mon 8th February 2021
Rating: 
(1 Votes)
Converts decimal numbers to binary sequence and will convert any binary sequence back to decimal just add the module to your project and call
VBcoders
'/////////////////////////////////////////////////////////////////////
'// This module will convert any whole decimal number to its' binary /
'// equivalent and back again as long as the number is equal to /
'// or smaller than 2 to the power 30, and not negative or contain /
'// decimal points. /
'// To convert to binary call GetBinaryNumber(number to convert) /
'// The binary sequence is returned as a string and NOT a number /
'// to convert back call GetDecimalNumber(number to convert) /
'// the decimal conversion is returned as a double /
'// /
'// Copyright C-Light Systems August 2000 /
'// Devised by J. Edwards for C-Light systems 9/8/00 /
'// /
'/////////////////////////////////////////////////////////////////////
Dim Digit(30) As Double 'set up array for integer values
Dim BinaryDigit(30) As Integer 'set up array for binary multipliers
Public FinalBinNum As String 'return final binary number
Public DecimalNumber As Double 'return decimal number
Public Function GetBinaryNumber(Number As Double)
Dim i As Integer
Dim Locater As Integer
Dim DecimalCheck As Integer
On Error GoTo ERROR_ROUTINE
'//////////////////////////////////////////////////////////////////////////////
For i = 0 To 30
BinaryDigit(i) = 0 'set binary digits to zero
Next i
i = 0
Digit(0) = 1 'set digit multiplier 1 to value 1
For i = 1 To 30 'multiply each successive digit by 2
Digit(i) = Digit(i - 1) * 2
Next i
FinalBinNum = 0 'reset number
If Number > 1073741824 Then '2 to power 30 = this so check for bigger
MsgBox "This Number is too Large"
Exit Function
End If
DecimalCheck = InStr(1, Number, ".", vbTextCompare) 'look for decimal point
If DecimalCheck > 0 Then 'if decimal found exit function
MsgBox "please no decimals"
Exit Function
End If
If Number < 0 Then 'look for neative numbers
MsgBox "please no negative numbers"
Exit Function
End If
Do While Number > 0 'calculate binary sequence
Select Case Number 'step through decimal number subtracting value of
Case Is >= Digit(30) '2 to the power X each time
Number = Number - Digit(30)
BinaryDigit(0) = 1
Case Is >= Digit(29)
Number = Number - Digit(29)
BinaryDigit(1) = 1
Case Is >= Digit(28)
Number = Number - Digit(28)
BinaryDigit(2) = 1
Case Is >= Digit(27)
Number = Number - Digit(27)
BinaryDigit(3) = 1
Case Is >= Digit(26)
Number = Number - Digit(26)
BinaryDigit(4) = 1
Case Is >= Digit(25)
Number = Number - Digit(25)
BinaryDigit(5) = 1
Case Is >= Digit(24)
Number = Number - Digit(24)
BinaryDigit(6) = 1
Case Is >= Digit(23)
Number = Number - Digit(23)
BinaryDigit(7) = 1
Case Is >= Digit(22)
Number = Number - Digit(22)
BinaryDigit(8) = 1
Case Is >= Digit(21)
Number = Number - Digit(21)
BinaryDigit(9) = 1
Case Is >= Digit(20)
Number = Number - Digit(20)
BinaryDigit(10) = 1
Case Is >= Digit(19)
Number = Number - Digit(19)
BinaryDigit(11) = 1
Case Is >= Digit(18)
Number = Number - Digit(18)
BinaryDigit(12) = 1
Case Is >= Digit(17)
Number = Number - Digit(17)
BinaryDigit(13) = 1
Case Is >= Digit(16)
Number = Number - Digit(16)
BinaryDigit(14) = 1
Case Is >= Digit(15)
Number = Number - Digit(15)
BinaryDigit(15) = 1
Case Is >= Digit(14)
Number = Number - Digit(14)
BinaryDigit(16) = 1
Case Is >= Digit(13)
Number = Number - Digit(13)
BinaryDigit(17) = 1
Case Is >= Digit(12)
Number = Number - Digit(12)
BinaryDigit(18) = 1
Case Is >= Digit(11)
Number = Number - Digit(11)
BinaryDigit(19) = 1
Case Is >= Digit(10)
Number = Number - Digit(10)
BinaryDigit(20) = 1
Case Is >= Digit(9)
Number = Number - Digit(9)
BinaryDigit(21) = 1
Case Is >= Digit(8)
Number = Number - Digit(8)
BinaryDigit(22) = 1
Case Is >= Digit(7)
Number = Number - Digit(7)
BinaryDigit(23) = 1
Case Is >= Digit(6)
Number = Number - Digit(6)
BinaryDigit(24) = 1
Case Is >= Digit(5)
Number = Number - Digit(5)
BinaryDigit(25) = 1
Case Is >= Digit(4)
Number = Number - Digit(4)
BinaryDigit(26) = 1
Case Is >= Digit(3)
Number = Number - Digit(3)
BinaryDigit(27) = 1
Case Is >= Digit(2)
Number = Number - Digit(2)
BinaryDigit(28) = 1
Case Is >= Digit(1)
Number = Number - Digit(1)
BinaryDigit(29) = 1
Case Is = Digit(0)
Number = Number - Digit(0)
BinaryDigit(30) = 1
End Select
Loop
i = 0 'reset counter
For i = 0 To 30 'put together binary sequence
FinalBinNum = FinalBinNum & BinaryDigit(i)
Next i
Locater = InStr(1, FinalBinNum, 1, vbTextCompare) 'look for first 1 in binary sequence
FinalBinNum = Mid(FinalBinNum, Locater, 30) 'remove leading zeros
'/////////////////////////////////////////////////////////////////////////////////////////
EXIT_ROUTINE:
Exit Function
ERROR_ROUTINE:
MsgBox Err.Description & Err.Number
Resume EXIT_ROUTINE
End Function
Public Function GetDecimalNumber(BinaryNumber As String)
Dim i As Integer
Dim Locater As Integer
Dim StrLength As Integer
On Error GoTo ERROR_ROUTINE
'//////////////////////////////////////////////////////////////////////////////
Digit(0) = 1 'setup binary multipliers
For i = 1 To 30 Step -1
Digit(i) = Digit(i - 1) * 2
Next i
StrLength = Len(BinaryNumber) 'get length of binary string
BinaryNumber = StrReverse(BinaryNumber) 'reverse binary string
DecimalNumber = 0 'reset decimal number
For i = 1 To StrLength
Locater = Mid(BinaryNumber, i, 1) 'get digit from binary string
DecimalNumber = DecimalNumber + (Val(Digit(i - 1)) * Locater) 'multiply digit by binary power
Next i 'and add to total
'/////////////////////////////////////////////////////////////////////////////////////////
EXIT_ROUTINE:
Exit Function
ERROR_ROUTINE:
MsgBox Err.Description & Err.Number
Resume EXIT_ROUTINE
End Function
No comments have been posted about Converts decimal numbers to binary sequence and will convert any binary sequence back to decimal ju. Why not be the first to post a comment about Converts decimal numbers to binary sequence and will convert any binary sequence back to decimal ju.