tpsystools_4.04/source/StMath.pas

// Upgraded to Delphi 2009: Sebastian Zierer

(* ***** BEGIN LICENSE BLOCK *****
 * Version: MPL 1.1
 *
 * The contents of this file are subject to the Mozilla Public License Version
 * 1.1 (the "License"); you may not use this file except in compliance with
 * the License. You may obtain a copy of the License at
 * http://www.mozilla.org/MPL/
 *
 * Software distributed under the License is distributed on an "AS IS" basis,
 * WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License
 * for the specific language governing rights and limitations under the
 * License.
 *
 * The Original Code is TurboPower SysTools
 *
 * The Initial Developer of the Original Code is
 * TurboPower Software
 *
 * Portions created by the Initial Developer are Copyright (C) 1996-2002
 * the Initial Developer. All Rights Reserved.
 *
 * Contributor(s):
 *
 * ***** END LICENSE BLOCK ***** *)

{*********************************************************}
{* SysTools: StMath.pas 4.04                             *}
{*********************************************************}
{* SysTools: Miscellaneous math functions                *}
{*********************************************************}

{$I StDefine.inc}

unit StMath;

interface

uses
  Windows,
  SysUtils, StDate, StBase, StConst;

const
  RadCor : Double = 57.29577951308232;    {number of degrees in a radian}

{$IFNDEF UseMathUnit}
  function IntPower(Base : Extended; Exponent : Integer): Extended;
    {-Raise Base to an integral power Exponent}

  function Power(Base, Exponent : Extended) : Extended;
    {-Raise Base to an arbitrary power Exponent}
{$ENDIF}

function StInvCos(X : Double): Double;
  {-Returns the ArcCos of Y}

function StInvSin(Y : Double): Double;
  {-Returns the ArcSin of Y}

  function StInvTan2(X, Y : Double) : Double;
  {-Returns the ArcTangent of Y / X}

function StTan(A : Double) : Double;
  {-Returns the Tangent of A}


{-------------------------------------------------------}

implementation

{$IFNDEF UseMathUnit}
  function IntPower(Base : Extended; Exponent : Integer): Extended;
  var
    Y : Integer;
  begin
    Y := Abs(Exponent);
    Result := 1;
    while (Y > 0) do begin
      while (not Odd(Y)) do begin
        Y := Y shr 1;
        Base := Base * Base;
      end;
      Dec(Y);
      Result := Result * Base;
    end;
    if (Exponent < 0) then
      Result := 1 / Result;
  end;

  {-------------------------------------------------------}

  function Power(Base, Exponent: Extended): Extended;
  begin
    if (Exponent = 0) then
      Result := 1
    else if (Base = 0) and (Exponent > 0) then
      Result := 0
    else if (Frac(Exponent) = 0) and (Abs(Exponent) <= MaxInt) then
      Result := IntPower(Base, Trunc(Exponent))
    else
      Result := Exp(Exponent * Ln(Base));
  end;
{$ENDIF}

{-------------------------------------------------------}

function StTan(A : Double) : Double;
var
  C, S : Double;
begin
  C := Cos(A);
  S := Sin(A);
  if (Abs(C) >= 5E-12) then
    Result := S / C
  else if (C < 0) then
    Result := 5.0e-324
  else
    Result := 1.7e+308;
end;

{-------------------------------------------------------}

function StInvTan2(X, Y : Double) : Double;
begin
  if (Abs(X) < 5.0E-12) then begin
    if (X < 0) then
      Result := 3 * Pi / 2
    else
      Result := Pi / 2;
  end else begin
    Result := ArcTan(Y / X);
    if (X < 0) then
      Result := Result + Pi
    else if (Y < 0) then
      Result := Result + 2 * Pi;
  end;
end;

{-------------------------------------------------------}

function StInvSin(Y : Double): Double;
begin
  if (Abs(Abs(Y) - 1) > 5.0E-12) then
    Result := ArcTan(Y / Sqrt(1 - Y * Y))
  else begin
    if (Y < 0) then
      Result := 3 * Pi / 2
    else
      Result := Pi / 2;
  end;
end;

{-------------------------------------------------------}

function StInvCos(X : Double): Double;
begin
  if (Abs(Abs(X) - 1) > 5.0E-12) then
    Result := (90 / RadCor) - ArcTan(X / Sqrt(1 - X * X))
  else begin
    if ((X - Pi / 2) > 0) then
      Result := 0
    else
      Result := Pi;
  end;
end;


end.
1	torben	2671	// Upgraded to Delphi 2009: Sebastian Zierer
2
3			(* *** BEGIN LICENSE BLOCK ***
4			* Version: MPL 1.1
5			*
6			* The contents of this file are subject to the Mozilla Public License Version
7			* 1.1 (the "License"); you may not use this file except in compliance with
8			* the License. You may obtain a copy of the License at
9			* http://www.mozilla.org/MPL/
10			*
11			* Software distributed under the License is distributed on an "AS IS" basis,
12			* WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License
13			* for the specific language governing rights and limitations under the
14			* License.
15			*
16			* The Original Code is TurboPower SysTools
17			*
18			* The Initial Developer of the Original Code is
19			* TurboPower Software
20			*
21			* Portions created by the Initial Developer are Copyright (C) 1996-2002
22			* the Initial Developer. All Rights Reserved.
23			*
24			* Contributor(s):
25			*
26			* *** END LICENSE BLOCK *** *)
27
28			{*********************************************************}
29			{* SysTools: StMath.pas 4.04 *}
30			{*********************************************************}
31			{* SysTools: Miscellaneous math functions *}
32			{*********************************************************}
33
34			{$I StDefine.inc}
35
36			unit StMath;
37
38			interface
39
40			uses
41			Windows,
42			SysUtils, StDate, StBase, StConst;
43
44			const
45			RadCor : Double = 57.29577951308232; {number of degrees in a radian}
46
47			{$IFNDEF UseMathUnit}
48			function IntPower(Base : Extended; Exponent : Integer): Extended;
49			{-Raise Base to an integral power Exponent}
50
51			function Power(Base, Exponent : Extended) : Extended;
52			{-Raise Base to an arbitrary power Exponent}
53			{$ENDIF}
54
55			function StInvCos(X : Double): Double;
56			{-Returns the ArcCos of Y}
57
58			function StInvSin(Y : Double): Double;
59			{-Returns the ArcSin of Y}
60
61			function StInvTan2(X, Y : Double) : Double;
62			{-Returns the ArcTangent of Y / X}
63
64			function StTan(A : Double) : Double;
65			{-Returns the Tangent of A}
66
67
68			{-------------------------------------------------------}
69
70			implementation
71
72			{$IFNDEF UseMathUnit}
73			function IntPower(Base : Extended; Exponent : Integer): Extended;
74			var
75			Y : Integer;
76			begin
77			Y := Abs(Exponent);
78			Result := 1;
79			while (Y > 0) do begin
80			while (not Odd(Y)) do begin
81			Y := Y shr 1;
82			Base := Base * Base;
83			end;
84			Dec(Y);
85			Result := Result * Base;
86			end;
87			if (Exponent < 0) then
88			Result := 1 / Result;
89			end;
90
91			{-------------------------------------------------------}
92
93			function Power(Base, Exponent: Extended): Extended;
94			begin
95			if (Exponent = 0) then
96			Result := 1
97			else if (Base = 0) and (Exponent > 0) then
98			Result := 0
99			else if (Frac(Exponent) = 0) and (Abs(Exponent) <= MaxInt) then
100			Result := IntPower(Base, Trunc(Exponent))
101			else
102			Result := Exp(Exponent * Ln(Base));
103			end;
104			{$ENDIF}
105
106			{-------------------------------------------------------}
107
108			function StTan(A : Double) : Double;
109			var
110			C, S : Double;
111			begin
112			C := Cos(A);
113			S := Sin(A);
114			if (Abs(C) >= 5E-12) then
115			Result := S / C
116			else if (C < 0) then
117			Result := 5.0e-324
118			else
119			Result := 1.7e+308;
120			end;
121
122			{-------------------------------------------------------}
123
124			function StInvTan2(X, Y : Double) : Double;
125			begin
126			if (Abs(X) < 5.0E-12) then begin
127			if (X < 0) then
128			Result := 3 * Pi / 2
129			else
130			Result := Pi / 2;
131			end else begin
132			Result := ArcTan(Y / X);
133			if (X < 0) then
134			Result := Result + Pi
135			else if (Y < 0) then
136			Result := Result + 2 * Pi;
137			end;
138			end;
139
140			{-------------------------------------------------------}
141
142			function StInvSin(Y : Double): Double;
143			begin
144			if (Abs(Abs(Y) - 1) > 5.0E-12) then
145			Result := ArcTan(Y / Sqrt(1 - Y * Y))
146			else begin
147			if (Y < 0) then
148			Result := 3 * Pi / 2
149			else
150			Result := Pi / 2;
151			end;
152			end;
153
154			{-------------------------------------------------------}
155
156			function StInvCos(X : Double): Double;
157			begin
158			if (Abs(Abs(X) - 1) > 5.0E-12) then
159			Result := (90 / RadCor) - ArcTan(X / Sqrt(1 - X * X))
160			else begin
161			if ((X - Pi / 2) > 0) then
162			Result := 0
163			else
164			Result := Pi;
165			end;
166			end;
167
168
169			end.