'BinaryFractions: 

Option Public
Option Explicit


Sub Initialize
	'** an example of converting fractional base 10 numbers to
	'** fractional binary numbers
	On Error Goto processError
	
	Dim numString As String
	Dim placesString As String
	Dim base10Num As Double
	Dim placesNum As Long
	Dim binaryString As String
	
	numString = "10.25"
	placesString = "25"
	
	Do While True
		numString = Inputbox("Please enter the floating point number you would like to convert to binary", _
		"Enter A Floating Point Number", numString)
		base10Num = Cdbl(numString)
		
		placesString = Inputbox("How many decimal places would you like the binary number to use?", _
		"How Many Decimal Places?", placesString)
		placesNum = Clng(placesString)
		
		binaryString = ConvertToBinary(base10Num, placesNum)
		Messagebox base10Num & " = " & binaryString, 0, "Result"
	Loop
	
	Exit Sub
	
processError:
	Print "Error " & Err & " on line " & Erl & ": " & Error$
	Exit Sub
	
End Sub


Function ConvertToBinary (base10Num As Double, places As Long) As String
	'** Function to convert a base 10 number to a binary number.
	'** If you're dealing with whole numbers, you can just do this
	'** with the built-in Bin() function; however, if you have a fractional
	'** number (like 1.23) you have to do a little work.
	'**
	'** version 1.0, March 15, 2005
	'** Julian Robichaux, http://www.nsftools.com
	
	Dim binaryString As String
	Dim repeatList List As Integer
	Dim tempNum As Double
	Dim roundAmt As Integer
	Dim i As Long
	
	'** get the whole number part using Bin
	binaryString = Bin(Fix(base10Num))
	
	'** we'll need to make sure to round our fractional numbers to
	'** the number of decimal places present in the original number
	'** we were given -- otherwise we can end up with occasional
	'** floating point conversion issues which will throw our 
	'** calculations off
	roundAmt = Len(Strright(base10Num, "."))
	tempNum = Round(Fraction(base10Num), roundAmt)
	
	'** add a decimal place if we do indeed have a fractional number
	'** to convert
	If (tempNum > 0) Then
		binaryString = binaryString & "."
	End If
	
	'** make sure our result only has up to the number of decimal places 
	'** specified by the "places" parameter when the function was called
	'** (otherwise, we could end up converting forever)
	For i = 1 To places
		If (tempNum = 0) Then
			Exit For
		End If
		
		'** we're using a List to keep track of fractional numbers we've 
		'** converted before. If we hit the same number twice, we have
		'** a repeating number in our result.
		If Iselement(repeatList(tempNum)) Then
			'** we hit a repeating number, so tell the user what the repeating
			'** number is and exit
			binaryString = binaryString & "... (number repeats with "
			Forall stuff In repeatList
				If (Listtag(stuff) = tempNum) Or (Right(binaryString, 1) <> " ") Then
					binaryString = binaryString & stuff
				End If
			End Forall
			binaryString = binaryString & ")"
			Exit For
		Else
			'** add to the list and keep on going
			repeatList(tempNum) = Fix(tempNum * 2)
			binaryString = binaryString & repeatList(tempNum)
			tempNum = Round(Fraction(tempNum * 2), roundAmt)
		End If
	Next
	
	'** if we got to the specified number of places and we were still converting,
	'** add "..." to the end of the number to indicate that we weren't done yet
	If (i > places) Then
		binaryString = binaryString & "..."
	End If
	
	ConvertToBinary = binaryString
	
End Function