FiveTech Support Forums

FiveWin / Harbour / xBase community
Board index FiveWin para Harbour/xHarbour Donde puedo sonseguir la lib de Nanforum toolkits (Nanfor.l
Posts: 225
Joined: Tue Feb 28, 2006 04:25 PM
Donde puedo sonseguir la lib de Nanforum toolkits (Nanfor.l
Posted: Fri Jan 19, 2007 10:14 PM

Donde puedo sonseguir la lib de Nanforum toolkits (Nanfor.lib)
para solucionar el probelma del round
usando la función es FT_Round().

Gracias

ME INTERESA FW Y XHB POR SER OPEN SOURCE
Posts: 592
Joined: Tue Mar 14, 2006 11:34 PM
Donde puedo sonseguir la lib de Nanforum toolkits (Nanfor.l
Posted: Sat Jan 20, 2007 12:18 AM

Vladimir :

/
* File......: Round.Prg
* Author....: David Husnian
* CIS ID....: ?
*
* This is an original work by David Husnian and is placed in the
* public domain.
*
* Modification history:
* ---------------------
*
* Rev 1.2 15 Aug 1991 23:05:30 GLENN
* Forest Belt proofread/edited/cleaned up doc
*
* Rev 1.1 14 Jun 1991 19:52:48 GLENN
* Minor edit to file header
*
* Rev 1.0 01 Apr 1991 01:02:08 GLENN
* Nanforum Toolkit
*
/

/ $DOC$
* $FUNCNAME$
* FT_ROUND()
* $CATEGORY$
* Math
* $ONELINER$
* Rounds a number to a specific place
* $SYNTAX$
* FT_ROUND( <nNumber> [, <nRoundToAmount> ;
* [, <cRoundType> [, <cRoundDirection> ;
* [, <nAcceptableError> ] ] ] ] ) -> nNumber
* $ARGUMENTS$
* <nNumber> is the number to round
*
* <nRoundToAmount> is the fraction to round to or the number of places,
* default is 2.
*
* <cRoundType> is the type of rounding desired
*
* "D" for Decimal (3 for thousandth, 1/1000) (default)
* "F" for Fraction (3 for thirds, 1/3)
* "W" for Whole numbers (3 for thousand, 1000)
*
* <cRoundDirection> is the direction to round the number toward
*
* "U" to round Up 1.31 -> 1.4
* -1.31 -> -1.4
* "D" to round Down 1.36 -> 1.3
* -1.36 -> -1.3
* "N" to round Normal 1.5 -> 2
* -1.5 -> -2
* 1.49 -> 1
* -1.49 -> -1
*
* <nAcceptableError> is the amount that is considered acceptable
* to be within, i.e., if you're within this amount of the number
* you don't need to round
* $RETURNS$
* The number, rounded as specified.
* $DESCRIPTION$
* This function will allow you to round a number. The following can
* be specified:
* a. Direction (up, down or normal - normal is 4/5 convention)
* b. Type (whole, decimal, fraction)
* c. Amount (100's, 5 decimals, 16th, etc.)
* $EXAMPLES$
* // round normal to 2 decimal places
* nDollars := FT_ROUND(nDollars)
*
* // round normal to 6 decimal places
* nIntRate := FT_ROUND(nIntRate, 6)
*
* // round to nearest thousands
* nPrice := FT_ROUND(nPrice, 3, NEAREST_WHOLE_NUMBER)
*
* // round Up to nearest third
* nAmount := FT_ROUND(nAmount, 3, NEAREST_FRACTION, ROUND_UP)
*
* // round down to 3 decimals Within .005
* nAvg := FT_ROUND(nAvg, 3, , ROUND_DOWN, .005)
* $END$
/

define IS_NEGATIVE(x) ((x) < 0)

define NEAREST_DECIMAL "D"

define NEAREST_FRACTION "F"

define NEAREST_WHOLE_NUMBER "W"

define ROUND_DOWN "D"

define ROUND_NORMAL "N"

define ROUND_UP "U"

command DEFAULT <Param1> TO <Def1> [, <ParamN> TO <DefN> ] ;

        =&gt; ;
        &lt;Param1&gt; := IF(&lt;Param1&gt; == NIL,&lt;Def1&gt;,&lt;Param1&gt;) ;
     [; &lt;ParamN&gt; := IF(&lt;ParamN&gt; == NIL,&lt;DefN&gt;,&lt;ParamN&gt;)]

command DEFAULT <Param1> TO <Def1> IF NOT <Type1> ;

             [, &lt;ParamN&gt; TO &lt;DefN&gt; IF NOT &lt;TypeN&gt; ] ;
        =&gt; ;
        &lt;Param1&gt; := IF(VALTYPE(&lt;Param1&gt;) == &lt;Type1&gt;,&lt;Param1&gt;,&lt;Def1&gt;) ;
     [; &lt;ParamN&gt; := IF(VALTYPE(&lt;ParamN&gt;) == &lt;TypeN&gt;,&lt;ParamN&gt;,&lt;DefN&gt;)]

FUNCTION FT_ROUND(nNumber, nRoundToAmount, cRoundType, cRoundDirection, ;
nAcceptableError)

LOCAL nResult := ABS(nNumber) // The Result of the Rounding

DEFAULT nRoundToAmount TO 2, ;
cRoundType TO NEAREST_DECIMAL, ;
cRoundDirection TO ROUND_NORMAL, ;
nAcceptableError TO 1 / (nRoundToAmount ** 2)

                                    // Are We Rounding to the Nearest Whole
                                    // Number or to Zero Decimal Places??

IF (LEFT(cRoundType,1) != NEAREST_WHOLE_NUMBER .AND. ;
(nRoundToAmount := INT(nRoundToAmount)) != 0)

                                    // No, Are We Rounding to the Nearest
                                    // Decimal Place??
  IF (LEFT(cRoundType,1) == NEAREST_DECIMAL)

                                    // Yes, Convert to Nearest Fraction
     nRoundToAmount := 10 ** nRoundToAmount

  ENDIF                             // LEFT(cRoundType,1) == NEAREST_DECIMAL

                                    // Are We Already Within the Acceptable
                                    // Error Factor??
  IF (ABS(INT(nResult * nRoundToAmount) - (nResult * nRoundToAmount)) &gt; ;
      nAcceptableError)
                                    // No, Are We Rounding Down??
     nResult -= IIF(LEFT(cRoundDirection,1) == ROUND_DOWN, ;
                                  ; // Yes, Make Downward Adjustment
                    1 / nRoundToAmount / 2, ;
                                  ; // Are We Rounding Up??
                    IIF(LEFT(cRoundDirection,1) == ROUND_UP , ;
                                  ; // Yes, Make Upward Adjustment
                        -1 / (nRoundToAmount) / 2, ;
                                  ; // No, Rounding Normal, No Adjustment
                        0))
                                    //Do the Actual Rounding
     nResult := INT((nRoundToAmount * nResult) + .5 + nAcceptableError) / ;
                nRoundToAmount

  ENDIF                             // ABS(INT(nResult * nRoundToAmount) -
                                    //     (mResult * nRoundAmount)) &gt;
                                    // nAcceptableError

ELSE // Yes, Round to Nearest Whole Number
// or to Zero Places

  nRoundToAmount := MAX(nRoundToAmount, 1)

  DO CASE                           // Do "Whole" Rounding

     CASE LEFT(cRoundDirection,1) == ROUND_UP

        nResult := (INT(nResult / nRoundToAmount) * nRoundToAmount) + ;
                   nRoundToAmount

     CASE LEFT(cRoundDirection,1) = ROUND_DOWN

        nResult := INT(nResult / nRoundToAmount) * nRoundToAmount

     OTHERWISE                      // Round Normally

        nResult := INT((nResult + nRoundToAmount / 2) / nRoundToAmount) * ;
                   nRoundToAmount

  ENDCASE

ENDIF // LEFT(cRoundType,1)!=NEAREST_WHOLE or
// nRoundToAmount == 0
IF IS_NEGATIVE(nNumber) // Was the Number Negative??
nResult := -nResult // Yes, Make the Result Negative Also
ENDIF // IS_NEGATIVE(nNumber)

RETURN (nResult) // FT_Round

Saludos

FWH 10.6 + xHarbour + Borland 582

Continue the discussion