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> ] ;
=> ;
<Param1> := IF(<Param1> == NIL,<Def1>,<Param1>) ;
[; <ParamN> := IF(<ParamN> == NIL,<DefN>,<ParamN>)]
#command DEFAULT <Param1> TO <Def1> IF NOT <Type1> ;
[, <ParamN> TO <DefN> IF NOT <TypeN> ] ;
=> ;
<Param1> := IF(VALTYPE(<Param1>) == <Type1>,<Param1>,<Def1>) ;
[; <ParamN> := IF(VALTYPE(<ParamN>) == <TypeN>,<ParamN>,<DefN>)]
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)) > ;
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)) >
// 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