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	// 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.