[VBnet Helpers] Pure VB: Converting Numbers to Fractions


	Visual Basic Helper Routines Pure VB: Converting Numbers to Fractions

Posted:	Monday March 25, 2002
Updated:	Monday December 26, 2011

Applies to:	VB4-32, VB5, VB6
Developed with:	VB6, Windows XP
OS restrictions:	None
Author:	Rick Rothstein

Related:	Pure VB: Converting Numbers to Fractions Pure VB: Converting Numbers to Roman Numerals (and Back) Pure VB: Implementing a Number-To-Text Conversion Function

Prerequisites

None.

Here's another routine by Rick Rothstein posted to the microsoft.public.vb.syntax newsgroup shows how to create a fractional representation of the a passed single value.

The method has two optional parameters - one added by me. The first - LargestDenominator - specifies the highest denominator for the fractions. Passing 2 will cause the fractions to round to 1/2, passing 4 to 1/4 and so on. The default value is 64, as shown in the illustration.

The second additional parameter - mine - controls the output display. If the bShowDash flag is set, the resulting output is formatted as 12-3/4. If not specified or set to False, the resulting string does not have the dash i.e. 12 3/4 as shown.

BAS Module Code

None.

Form Code

To a form add a listbox (List1) and a command button (Command1) along with the following:

Option Explicit

''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Copyright ©1996-2011 VBnet/Randy Birch, All Rights Reserved.
' Some pages may also contain other copyrights by the author.
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Distribution: You can freely use this code in your own
'               applications, but you may not reproduce 
'               or publish this code on any web site,
'               online service, or distribute as source 
'               on any media without express permission.
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

Private Declare Function SendMessage Lib "user32" _
   Alias "SendMessageA" _
  (ByVal hwnd As Long, _
   ByVal wMsg As Long, _
   ByVal wParam As Long, _
   lParam As Any) As Long

Private Const LB_SETTABSTOPS As Long = &H192


Private Sub Form_Load()

   ReDim TabArray(0 To 1) As Long
   
   TabArray(0) = 66
   TabArray(1) = 66
   
  'set the list tabstops
   Call SendMessage(List1.hwnd, LB_SETTABSTOPS, 0&, ByVal 0&)
   Call SendMessage(List1.hwnd, LB_SETTABSTOPS, 1&, TabArray(0))
   List1.Refresh
   
   Randomize Time
   Command1.Caption = "Convert Fractions"
  
End Sub


Private Sub Command1_Click()

   Dim nValue As Single
   Dim sRoman As String
   
   List1.Clear
   
  'create 20 random single values
  'between 1 and 50
   Do
     'create a random number
      nValue = (Rnd(1) * 50) + 1
      
     'trim to two decimals (VB6 only)
      nValue = FormatNumber(nValue, 2)

     'create the fractional value
      sRoman = MakeFraction(nValue, 64, True)
      
     'display numeric and fraction values
      List1.AddItem nValue & vbTab & _
                    sRoman
      
   Loop Until List1.ListCount = 20
 
End Sub


Function MakeFraction(ByVal DecimalNumber As Variant, _
                      Optional ByVal LargestDenominator As Long = 64, _
                      Optional bShowDash As Boolean = False) As String
  
   Dim GCD As Long
   Dim TopNumber As Long
   Dim Remainder As Long
   Dim WholeNumber As Long
   Dim Numerator As Long
   Dim Denominator As Long
  
   If IsNumeric(DecimalNumber) Then
   
      DecimalNumber = CDbl(DecimalNumber)
      WholeNumber = Fix(DecimalNumber)
      Denominator = LargestDenominator
      Numerator = Format(Denominator * _
                           Abs(DecimalNumber - WholeNumber), "0")
                           
      If Numerator Then
      
         GCD = LargestDenominator
         TopNumber = Numerator
         
         Do
         
            Remainder = (GCD Mod TopNumber)
            GCD = TopNumber
            TopNumber = Remainder
            
         Loop Until Remainder = 0
         
         Numerator = Numerator \ GCD
         Denominator = Denominator \ GCD
         
         MakeFraction = CStr(WholeNumber) & _
                        IIf(bShowDash, "-", "  ") & _
                        CStr(Numerator) & "/" & _
                        CStr(Denominator)
      Else
      
        MakeFraction = CStr(WholeNumber)
        
      End If
      
   Else
   
     'Input wasn't a number, handle error here
     
   End If
   
End Function

Comments

PayPal Link