|
code
newsgroups
|
|||||||||||||||||||||||
|
|||||||||||||||||||||||
Convert decimal to fraction stringbut since I love public humiliation so much <g> here goes my stab at it .... given a decimal value I want to get a string representation of it's fractional equivalent 99% of the time I'll be working with "architectural" units eg 1/16, 3/32, 7/64, 3 3/16, etc so my testing below was rather limited Rick will probably have a one-liner for this or someone will point out a built in vb function<g> in any case, observations, corrections appreciated seems to work in the limited testing shown below.... Function DecimalToFraction(InDecimal As Double, Optional Tolerance As Double = 0.00390625, Optional RoundError As Double = 0) As String 'default limit to 1/256 tolerance If InDecimal > 1 Then'get whole number part Dim DecStr As String DecStr = CStr(InDecimal) Dim lDec As Long lDec = InStr(1, DecStr, ".") If lDec > 0 Then Dim WholeNum As String WholeNum = Left$(DecStr, lDec - 1) Else WholeNum = InDecimal GoTo ExitHere End If Dim dDecimal As Double dDecimal = CDbl(Right$(DecStr, Len(DecStr) - (lDec - 1))) Else dDecimal = InDecimal End If If dDecimal < Tolerance Then RoundError = dDecimal dDecimal = 0 Else RoundError = 0 End If If dDecimal = 0 Then If Len(WholeNum) = 0 Then WholeNum = "0" End If GoTo ExitHere End If Dim Numerator As Double Dim Denominator As Double Numerator = 1 CheckNumerator: Denominator = Numerator / dDecimal Dim Fraction As String If Denominator = Numerator Then WholeNum = "1" GoTo ExitHere Else If Denominator = Fix(Denominator) Then Fraction = CStr(Numerator) & "/" & CStr(Denominator) Else Numerator = Numerator + 2 GoTo CheckNumerator End If End If ExitHere: If Len(WholeNum) > 0 Then If Len(Fraction) > 0 Then DecimalToFraction = WholeNum & " " & Fraction Else DecimalToFraction = WholeNum End If Else If Len(Fraction) > 0 Then DecimalToFraction = Fraction End If End If End Function Sub testDec() Dim dFrac As Double Dim dInc As Double dInc = 0.015625 While dFrac < 3 Debug.Print CStr(dFrac) & " = " & DecimalToFraction(dFrac) dFrac = dFrac + dInc Wend Dim dErr As Double dFrac = 0.000001 While dFrac < 1 dErr = 0 Debug.Print CStr(dFrac) & " = " & DecimalToFraction(dFrac, , dErr) If dErr > 0 Then Debug.Print "With a rounding error of " & dErr End If dFrac = dFrac * 10 Wend End Sub > This is probably an idiotic way to get there... If it helps you any, here is a response along with a function (actually, two > but since I love public humiliation so much <g> here goes my stab at it > .... > > given a decimal value I want to get a string representation of it's > fractional equivalent > 99% of the time I'll be working with "architectural" units eg 1/16, 3/32, > 7/64, 3 3/16, etc so my testing below was rather limited > > Rick will probably have a one-liner for this or someone will point out a > built in vb function<g> > > in any case, observations, corrections appreciated working in tandem) that I posted a few years back. Rick Consider this answer from a previous post of mine (remember, this was an answer to someone else's question; hence the reference to the number 7.25489)... Try this function. You can specify the maximum denominator to use in the optional 2nd parameter. If you leave it out, then a default value of 64 is used. The function rounds, either up or down, to the *closest* fraction having the unit of resolution set by the 2nd argument. So, your value of 7.25489 will round to 7-1/4 even though the decimal part is more than 1/4 (it is closer to 1/4 than it is to 17/64, the next fraction past 1/4 using the 1/64 unit-of-resolution). By the way, the routine does not limit you to using denominators that are powers of two (although those are probably the only ones that make sense). That means, if you specify a 2nd parameter of 47, you will receive 7-12/47 as an answer. If your version of VB only supports optional arguments that are Variants (and can't be defaulted), then you will have to modify the function definition accordingly and set the default value of 64 inside of your function. If your version of VB doesn't support optional arguments at all, then simply turn it into a required argument. 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 IsNumber(DecimalNumber) Then DecimalNumber = CDbl(DecimalNumber) WholeNumber = Fix(DecimalNumber) Denominator = LargestDenominator Numerator = Format(Denominator * _ Abs(DecimalNumber - WholeNumber), "0") If Numerator = Denominator Then Numerator = 0 WholeNumber = WholeNumber + 1 End If 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 Function IsNumber(ByVal Value As String) As Boolean ' Leave the next statement out if you don't ' want to provide for plus/minus signs If Value Like "[+-]*" Then Value = Mid$(Value, 2) IsNumber = Not Value Like "*[!0-9.]*" And _ Not Value Like "*.*.*" And _ Len(Value) > 0 And Value <> "." And _ Value <> vbNullString End Function "Rick Rothstein (MVP - VB)" <rickNOSPAMnews@NOSPAMcomcast.net> wrote in well, I'm really disappointed...that's wayyy more than one linemessage news:u09je$FXHHA.4908@TK2MSFTNGP06.phx.gbl... > If it helps you any, here is a response along with a function (actually, two > working in tandem) that I posted a few years back. > > Rick > > Function MakeFraction(ByVal DecimalNumber As Variant, _ > End Function > > <gdr> guess i should have googled before wasting a couple hours on that eh? also found CFraction by Larry Serflaten oh well, the doing is half the fun and at least I'm glad that I wasnt' totally off base...just more wordy and less elegant.. :-) Thanks againMark "MP" <NoSpam@Thanks.Com> wrote I found that too and added a few optional parameters.> also found CFraction by Larry Serflaten I did not do much testing before I posted, and later saw that it did not round up properly. This one does better: LFS Private Function ArcFormat(ByVal Value As Single, _ Optional Tolerant As Boolean = False, _ Optional Exponent As Byte = 6) As String ' Returns arcitectural format of decimal Value ' * Tolerant > True = round out; False = round in ' * Exponent > Smallest unit of measurement = 1 / (2 ^ Exponent) ' (smallest unit limited to 1 / 1073741824) Dim num As Long, den As Long, whl As Long, unit As Long Dim neg As String If Value < 0 Then neg = "-" Value = Abs(Value) End If If Value >= 1 Then whl = Int(Value) Value = Value - whl End If If Exponent > 30 Then Exponent = 30 End If unit = 2 ^ Exponent If Tolerant Then num = Int(Value * unit + 0.99999999999999) Else num = Int(Value * unit) End If If num >= 1 Then den = unit Do While (num And 1) = 0 num = num \ 2 den = den \ 2 Loop End If If den > 1 Then ArcFormat = neg & CStr(whl) & " " & CStr(num) & "/" & CStr(den) Else ArcFormat = neg & CStr(whl + num) End If End Function "MP" <NoSpam@Thanks.Com> wrote Here is a little less verbose version that works with scales that> This is probably an idiotic way to get there... > but since I love public humiliation so much <g> here goes my stab at it .... > > given a decimal value I want to get a string representation of it's > fractional equivalent > 99% of the time I'll be working with "architectural" units eg 1/16, 3/32, > 7/64, 3 3/16, etc so my testing below was rather limited > are a power of 2 (as arcitectural dimensions are). LFS Private Function ArcFormat(ByVal Value As Single, _ Optional Tolerant As Boolean = False, _ Optional Exponent As Byte = 6) As String ' Returns arcitectural format of decimal Value ' * Tolerant > True = round up; False = round down ' * Exponent > Smallest unit of measurement = 1 / (2 ^ Exponent) ' (smallest unit limited to 1 / 1073741824) Dim num As Long, den As Long, unit As Long If Value < 0 Then ArcFormat = "-" Value = Abs(Value) End If If Value >= 1 Then ArcFormat = ArcFormat & CStr(Int(Value)) & " " Value = Value - Int(Value) End If If Exponent > 30 Then Exponent = 30 End If unit = 2 ^ Exponent If Tolerant Then num = Int(Value * unit + 0.5) Else num = Int(Value * unit) End If If num >= 1 Then den = unit Do While (num And 1) = 0 num = num \ 2 den = den \ 2 Loop ArcFormat = ArcFormat & CStr(num) & "/" & CStr(den) End If End Function "Larry Serflaten" <serfla***@usinternet.com> wrote in message Yeah, maybe more than a *little* less verbose :-)news:%23mLKgzGXHHA.896@TK2MSFTNGP05.phx.gbl... > > "MP" <NoSpam@Thanks.Com> wrote > > > Here is a little less verbose version that works with scales that > are a power of 2 (as arcitectural dimensions are). ....but thanks for being so kind <g> Thanks Mark
Data Type String
VB6 App Deployment in Vista Problems after installing Visual Basic 6 on XP Professional SP2 OT - MS: $4,000 for Daylight Saving Fix Looking for a way to call LogOff and Shutdown. Autologon on Vista VB6 User Control next problem Error '50003' Unspecified error in VB6 Program Read/Write permission (earn your quarter, Karl!) Random access file help |
|||||||||||||||||||||||