MMMath.pas
上传用户:hylc_2004
上传日期:2014-01-23
资源大小:46800k
文件大小:7k
源码类别:

Delphi控件源码

开发平台:

Delphi

  1. {========================================================================}
  2. {=                (c) 1995-98 SwiftSoft Ronald Dittrich                 =}
  3. {========================================================================}
  4. {=                          All Rights Reserved                         =}
  5. {========================================================================}
  6. {=  D 01099 Dresden             = Tel.: +0351-8012255                   =}
  7. {=  Loewenstr.7a                = info@swiftsoft.de                     =}
  8. {========================================================================}
  9. {=  Actual versions on http://www.swiftsoft.de/mmtools.html             =}
  10. {========================================================================}
  11. {=  This code is for reference purposes only and may not be copied or   =}
  12. {=  distributed in any format electronic or otherwise except one copy   =}
  13. {=  for backup purposes.                                                =}
  14. {=                                                                      =}
  15. {=  No Delphi Component Kit or Component individually or in a collection=}
  16. {=  subclassed or otherwise from the code in this unit, or associated   =}
  17. {=  .pas, .dfm, .dcu, .asm or .obj files may be sold or distributed     =}
  18. {=  without express permission from SwiftSoft.                          =}
  19. {=                                                                      =}
  20. {=  For more licence informations please refer to the associated        =}
  21. {=  HelpFile.                                                           =}
  22. {========================================================================}
  23. {=  $Date: 20.01.1998 - 18:00:00 $                                      =}
  24. {========================================================================}
  25. unit MMMath;
  26. {$I COMPILER.INC}
  27. interface
  28. const
  29.   {$IFDEF BCB} {$EXTERNALSYM M_PI} {$ENDIF}
  30.    M_PI  = 3.14159265358979323846;
  31.   {$IFDEF BCB} {$EXTERNALSYM M2_PI} {$ENDIF}
  32.    M2_PI = 2 * M_PI;
  33. function MinR(a, b: extended): extended;
  34. function MaxR(a, b: extended): extended;
  35. function MinMaxR(x, min, max: extended): extended;
  36. function LimitR(x, min, max: extended): extended;
  37. function ModR(x,y: extended): extended;
  38. function ArcCos(x: extended): extended;  { IN: |X| <= 1  OUT: [0..PI] radians }
  39. function ArcSin(x: extended): extended;  { IN: |X| <= 1  OUT: [-PI/2..PI/2] radians }
  40. function ArcTan2(y, x: extended): extended;
  41. function Tan(x: extended): extended;
  42. function Cotan(x: extended): extended;   { 1 / tan(X), X <> 0 }
  43. function Ceil(x: extended): longint;
  44. function Floor(x: extended): Longint;
  45. function Log(x: extended): extended;
  46. function Log2(x: extended): extended;
  47. function Log10(x: extended): extended;
  48. function Pow(x,n: extended): extended;
  49. implementation
  50. {-------------------------------------------------------------------------}
  51. { MinR: Returns the smallest signed value }
  52. function MinR(a, b: extended): extended;
  53. begin
  54.    if a < b then Result := a
  55.    else Result := b;
  56. end;
  57. {-------------------------------------------------------------------------}
  58. { MaxR: Returns the largest signed value }
  59. function MaxR(a, b: extended): extended;
  60. begin
  61.    if a > b then Result := a
  62.    else Result := b;  
  63. end;
  64. {-------------------------------------------------------------------------}
  65. { MinMaxR: Returns a value between Min and Max }
  66. function MinMaxR(x, min, max: extended): extended;
  67. begin
  68.    if x < min then Result := min
  69.    else if x > max then Result := max
  70.    else Result := x;
  71. end;
  72. {-------------------------------------------------------------------------}
  73. function LimitR(x, min, max: extended): extended;
  74. begin
  75.    if (max >= min) then
  76.    begin
  77.       if (x < min) then x := min
  78.       else if (x > max) then x := max;
  79.    end
  80.    else
  81.    begin
  82.       if (x < max) then x := max
  83.       else if (x > min) then x := min;
  84.    end;
  85.    Result := x;
  86. end;
  87. {-------------------------------------------------------------------------}
  88. { ModR: Real modulo                                                       }
  89. function ModR(x,y: extended): extended;
  90. begin
  91.    Result := x - int(x/y)*y;
  92. end;
  93. {-------------------------------------------------------------------------}
  94. { Ceil: Smallest integer >= X, |X| < MaxInt }
  95. function Ceil(x: extended): longint;
  96. begin
  97.    Result := Trunc(x);
  98.    if Frac(x) > 0 then inc(Result);
  99. end;
  100. {-------------------------------------------------------------------------}
  101. { Floor: Largest integer <= X,  |X| < MaxInt }
  102. function Floor(x: extended): longint;
  103. begin
  104.    Result := Trunc(x);
  105.    if Frac(x) < 0 then dec(Result);
  106. end;
  107. {-------------------------------------------------------------------------}
  108. function ArcCos(x: extended): extended;
  109. begin
  110.    Result := ArcTan2(Sqrt(1 - x*x), x);
  111. end;
  112. {-------------------------------------------------------------------------}
  113. function ArcSin(x: extended): extended;
  114. begin
  115.    Result := ArcTan2(x, Sqrt(1 - x*x))
  116. end;
  117. {-------------------------------------------------------------------------}
  118. function ArcTan2(y, x: extended): extended; assembler;
  119. asm
  120.       fld     y
  121.       fld     x
  122.       fpatan
  123.       fwait
  124. end;
  125. {-------------------------------------------------------------------------}
  126. function Tan(x: extended): extended; assembler;
  127. {  Tan := Sin(X) / Cos(X) }
  128. asm
  129.       fld     x
  130.       fptan
  131.       fstp    st(0)      { FPTAN pushes 1.0 after result }
  132.       fwait
  133. end;
  134. {-------------------------------------------------------------------------}
  135. function CoTan(x: extended): extended; assembler;
  136. { CoTan := Cos(X) / Sin(X) = 1 / Tan(X) }
  137. asm
  138.       fld     x
  139.       fptan
  140.       fdivrp
  141.       fwait
  142. end;
  143. {-------------------------------------------------------------------------}
  144. function Log(x: extended): extended; assembler;
  145. asm
  146.       fld1
  147.       fld     x
  148.       fyl2x
  149.       fldl2e
  150.       fdivp   st(1),st
  151.       fwait
  152. end;
  153. {-------------------------------------------------------------------------}
  154. function Log2(X: Extended): Extended; assembler;
  155. asm
  156.       fld1
  157.       fld     x
  158.       fyl2x
  159.       fwait
  160. end;
  161. {-------------------------------------------------------------------------}
  162. function Log10(x: extended): extended; assembler;
  163. asm
  164.       fldlg2  { Log base ten of 2 }
  165.       fld     x
  166.       fyl2x
  167.       fwait
  168. end;
  169. {-------------------------------------------------------------------------}
  170. function Pow(x,n: extended): extended; assembler;
  171. asm
  172.       fld     n
  173.       fld     x
  174.       fyl2x
  175.       fld     st(0)
  176.       frndint
  177.       fld     st(0)
  178.       fsubp   st(2), st
  179.       fxch    st(1)
  180.       f2xm1
  181.       fld1
  182.       faddp   st(1), st
  183.       fscale
  184.       fstp    st(1)
  185. end;
  186. end.