~ubuntu-branches/ubuntu/utopic/mricron/utopic

« back to all changes in this revision

Viewing changes to fpmath/uround.pas

  • Committer: Bazaar Package Importer
  • Author(s): Michael Hanke
  • Date: 2010-07-29 22:07:43 UTC
  • Revision ID: james.westby@ubuntu.com-20100729220743-q621ts2zj806gu0n
Tags: upstream-0.20100725.1~dfsg.1
ImportĀ upstreamĀ versionĀ 0.20100725.1~dfsg.1

Show diffs side-by-side

added added

removed removed

Lines of Context:
 
1
{ ******************************************************************
 
2
  Rounding functions
 
3
  Based on FreeBASIC version contributed by R. Keeling
 
4
  ****************************************************************** }
 
5
 
 
6
unit uround;
 
7
 
 
8
interface
 
9
 
 
10
uses
 
11
  utypes, uminmax, umath;
 
12
 
 
13
function RoundN(X : Float; N : Integer) : Float;
 
14
{ Rounds X to N decimal places }
 
15
 
 
16
function Ceil(X : Float) : Integer;
 
17
{ Ceiling function }
 
18
 
 
19
function Floor(X : Float) : Integer;
 
20
{ Floor function }
 
21
 
 
22
implementation
 
23
 
 
24
function RoundN (X : Float; N : Integer) : Float;
 
25
const
 
26
  MaxRoundPlaces = 18;
 
27
var
 
28
  ReturnAnswer, Dec_Place : Float;
 
29
  I : Integer;
 
30
begin
 
31
  if (N >= 0) and (N < MaxRoundPlaces) then I := N else I := 0;
 
32
  Dec_Place := Exp10(I);
 
33
  ReturnAnswer := Int((Abs(X) * Dec_Place) + 0.5);
 
34
  RoundN := Sgn(X) * ReturnAnswer / Dec_Place;
 
35
end;
 
36
 
 
37
function Ceil(X : Float) : Integer;
 
38
var
 
39
  ReturnAnswer : Integer;
 
40
begin
 
41
  ReturnAnswer := Trunc(X);
 
42
  if ReturnAnswer < X then ReturnAnswer := ReturnAnswer + 1;
 
43
  Ceil := ReturnAnswer;
 
44
end;
 
45
 
 
46
function Floor(X : Float) : Integer;
 
47
var
 
48
  ReturnAnswer : Integer;
 
49
begin
 
50
   ReturnAnswer := Trunc(X);
 
51
   if ReturnAnswer > X then ReturnAnswer := ReturnAnswer - 1;
 
52
   Floor := ReturnAnswer;
 
53
end;
 
54
 
 
55
end.
 
 
b'\\ No newline at end of file'