DecToFrac - Converts a decimal number into a fraction

' Converts a decimal value into fractional parts as integers
' (based on the concept of Continued Fractions)
' Examples of usage:
' Call DeclToFrac(0.125, a, b) ' 1 and 8 are returned in a & b
' Call DecToFrac(5/40, a, b) ' 1 and 8 are also returned
' Call DecToFrac(2/3, a, b) ' 2 and 3 are returned
' Since more than one value needs to be returned, they are returned
' to variables which are passed by reference as arguments (Numerator
' and Denom) to the DecToFrac Sub procedure
Sub DecToFrac(DecimalNum As Double, Numerator As Long, Denom As Long)
' The BigNumber constant can be adjusted to handle larger fractional parts
Const BigNumber = 50000
Const SmallNumber = 1E-16
Dim Inverse As Double, FractionalPart As Double
Dim WholePart As Long, SwapTemp As Long
Inverse = 1 / DecimalNum
WholePart = Int(Inverse)
FractionalPart = Frac(Inverse)
If 1 / (FractionalPart + SmallNumber) < BigNumber Then
' Notice that DecToFrac is called recursively.
Call DecToFrac(FractionalPart, Numerator, Denom)
Numerator = Denom * WholePart + Numerator
SwapTemp = Numerator
Numerator = Denom
Denom = SwapTemp
Else ' If 1 / (FractionalPart + SmallNumber) > BigNumber
' Recursion stops when the final value of FractionalPart is 0 or
' close enough. SmallNumber is added to prevent division by 0.
Numerator = 1
Denom = Int(Inverse)
End If
End Sub
' This function is used by DecToFrac and DecToProperFact
Function Frac(x As Double) As Double
Frac = Abs(Abs(x) - Int(Abs(x)))
End Function
' This additional procedure handles "improper" fractions and returns
' them in mixed form (a b/c) when the numerator is larger than the denominator
Sub DecToProperFrac(x As Double, a As Long, b As Long, c As Long)
If x > 1 Then a = Int(x)
If Frac(x) <> 0 Then
Call DecToFrac(Frac(x), b, c)
End If
End Sub
'#####################################################################
'#
'# This item has been brought to you by Daniel Corbier, the author of
'# UCalc Fast Math Parser, a component which allows programs to
'# evaluate expressions that are defined at runtime. You can learn
'# more and download a fully functional copy at www.ucalc.com/mathparser
'#
'#####################################################################