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


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

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

 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))
   Randomize Time
   Command1.Caption = "Convert Fractions"
End Sub

Private Sub Command1_Click()

   Dim nValue As Single
   Dim sRoman As String
  'create 20 random single values
  'between 1 and 50
     '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 & _
   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
            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) & "/" & _
        MakeFraction = CStr(WholeNumber)
      End If
     'Input wasn't a number, handle error here
   End If
End Function


PayPal Link
Make payments with PayPal - it's fast, free and secure!


Copyright 1996-2011 VBnet and Randy Birch. All Rights Reserved.
Terms of Use  |  Your Privacy


Hit Counter