jclcomplex.pas

East make Tray Icon in delphi

function TJclComplex.CNewCotH: TJclComplex;
var
  ResValue: TRectCoord;
begin
  ResValue := CoreCotH(RectCoord(Self));
  Result := TJclComplex.Create(ResValue.X, ResValue.Y, crRectangular);
  Result.FFracLen := FFracLen;
end;

function TJclComplex.CoreSecH(const Value: TRectCoord): TRectCoord;
var
  TempValue: TRectCoord;
begin
  TempValue := CoreCosH(Value);
  if MiscalcSingle(AbsoluteValue(TempValue)) <> 0.0 then
    Result := CoreDiv(RectOne, TempValue)
  else
    Result := RectInfinity;
end;

function TJclComplex.CSecH: TJclComplex;
var
  ResValue: TRectCoord;
begin
  ResValue := CoreSecH(RectCoord(Self));
  FCoord.X := ResValue.X;
  FCoord.Y := ResValue.Y;
  Result := Self;
end;

function TJclComplex.CNewSecH: TJclComplex;
var
  ResValue: TRectCoord;
begin
  ResValue := CoreSecH(RectCoord(Self));
  Result := TJclComplex.Create(ResValue.X, ResValue.Y, crRectangular);
  Result.FFracLen := FFracLen;
end;

function TJclComplex.CoreCscH(const Value: TRectCoord): TRectCoord;
var
  TempValue: TRectCoord;
begin
  TempValue := CoreSinH(Value);
  if MiscalcSingle(AbsoluteValue(TempValue)) <> 0.0 then
    Result := CoreDiv(RectOne, TempValue)
  else
    Result := RectInfinity;
end;

function TJclComplex.CCscH: TJclComplex;
var
  ResValue: TRectCoord;
begin
  ResValue := CoreCscH(RectCoord(Self));
  FCoord.X := ResValue.X;
  FCoord.Y := ResValue.Y;
  Result := Self;
end;

function TJclComplex.CNewCscH: TJclComplex;
var
  ResValue: TRectCoord;
begin
  ResValue := CoreCscH(RectCoord(Self));
  Result := TJclComplex.Create(ResValue.X, ResValue.Y, crRectangular);
  Result.FFracLen := FFracLen;
end;

//=== complex Bessel functions of order zero =================================

function TJclComplex.CoreI0(const Value: TRectCoord): TRectCoord;
var
  zSQR25, term: TRectCoord;
  i: Integer;
  SizeSqr: Float;
begin
  Result := RectOne;
  zSQR25 := CoreMul(Value, Value);
  zSQR25 := RectCoord(0.25 * zSQR25.X, 0.25 * zSQR25.Y);
  term := zSQR25;
  Result := CoreAdd(Result, zSQR25);
  i := 1;
  repeat
    term := CoreMul(zSQR25, term);
    Inc(i);
    term := RectCoord(term.X / Sqr(i), term.Y / Sqr(i));
    Result := CoreAdd(Result, term);
    SizeSqr := Sqr(term.X) + Sqr(term.Y);
  until (i > MaxTerm) or (SizeSqr < EpsilonSqr)
end;

function TJclComplex.CI0: TJclComplex;
var
  ResValue: TRectCoord;
begin
  ResValue := CoreI0(RectCoord(Self));
  FCoord.X := ResValue.X;
  FCoord.Y := ResValue.Y;
  Result := Self;
end;

function TJclComplex.CNewI0: TJclComplex;
var
  ResValue: TRectCoord;
begin
  ResValue := CoreI0(RectCoord(Self));
  Result := TJclComplex.Create(ResValue.X, ResValue.Y, crRectangular);
  Result.FFracLen := FFracLen;
end;

function TJclComplex.CoreJ0(const Value: TRectCoord): TRectCoord;
var
  zSQR25, term: TRectCoord;
  i: Integer;
  SizeSqr: Float;
  addFlag: Boolean;
begin
  Result := RectOne;
  zSQR25 := CoreMul(Value, Value);
  zSQR25 := RectCoord(0.25 * zSQR25.X, 0.25 * zSQR25.Y);
  term := zSQR25;
  Result := CoreSub(Result, zSQR25);
  addFlag := False;
  i := 1;
  repeat
    term := CoreMul(zSQR25, term);
    Inc(i);
    addFlag := not addFlag;
    term := RectCoord(term.X / Sqr(i), term.Y / Sqr(i));
    if addFlag then
      Result := CoreAdd(Result, term)
    else
      Result := CoreSub(Result, term);
    SizeSqr := Sqr(term.X) + Sqr(term.Y);
  until (i > MaxTerm) or (SizeSqr < EpsilonSqr)
end;

function TJclComplex.CJ0: TJclComplex;
var
  ResValue: TRectCoord;
begin
  ResValue := CoreJ0(RectCoord(Self));
  FCoord.X := ResValue.X;
  FCoord.Y := ResValue.Y;
  Result := Self;
end;

function TJclComplex.CNewJ0: TJclComplex;
var
  ResValue: TRectCoord;
begin
  ResValue := CoreJ0(RectCoord(Self));
  Result := TJclComplex.Create(ResValue.X, ResValue.Y, crRectangular);
  Result.FFracLen := FFracLen;
end;

function TJclComplex.CoreApproxLnGamma(const Value: TRectCoord): TRectCoord;
const
  c: array [1..8] of Float =
   (1.0 / 12.0, -1.0 / 360.0, 1.0 / 1260.0, -1.0 / 1680.0,
    1.0 / 1188.0, -691.0 / 360360.0, 1.0 / 156.0, -3617.0 / 122400.0);
var
  i: Integer;
  Powers: array [1..8] of TRectCoord;
  temp1, temp2: TRectCoord;
begin
  temp1 := CoreLn(Value);
  temp2 := RectCoord(Value.X - 0.5, Value.Y);
  Result := CoreAdd(temp1, temp2);
  Result := CoreSub(Result, Value);
  Result.X := Result.X + hLn2PI;

  temp1 := RectOne;
  Powers[1] := CoreDiv(temp1, Value);
  temp2 := CoreMul(powers[1], Powers[1]);
  for i := 2 to 8 do
    Powers[i] := CoreMul(Powers[i - 1], temp2);
  for i := 8 downto 1 do
  begin
    temp1 := RectCoord(c[i] * Powers[i].X, c[i] * Powers[i].Y);
    Result := CoreAdd(Result, temp1);
  end;
end;

function TJclComplex.CApproxLnGamma: TJclComplex;
var
  ResValue: TRectCoord;
begin
  ResValue := CoreApproxLnGamma(RectCoord(Self));
  FCoord.X := ResValue.X;
  FCoord.Y := ResValue.Y;
  Result := Self;
end;

function TJclComplex.CNewApproxLnGamma: TJclComplex;
var
  ResValue: TRectCoord;
begin
  ResValue := CoreApproxLnGamma(RectCoord(Self));
  Result := TJclComplex.Create(ResValue.X, ResValue.Y, crRectangular);
  Result.FFracLen := FFracLen;
end;

function TJclComplex.CoreLnGamma(Value: TRectCoord): TRectCoord;
var
  lna, temp: TRectCoord;
begin
  if (Value.X <= 0.0) and (MiscalcSingle(Value.Y) = 0.0) then
    if MiscalcSingle(Int(Value.X - 1E-8) - Value.X) = 0.0 then
    begin
      Result := RectInfinity;
      Exit;
    end;

  if Value.Y < 0.0 then
  begin
    Value := RectCoord(Value.X, -Value.Y);
    Result := CoreLnGamma(Value);
    Result := RectCoord(Result.X, -Result.Y);
  end
  else
  begin
    if Value.X < 9.0 then
    begin
      lna := CoreLn(Value);
      Value := RectCoord(Value.X + 1, Value.Y);
      temp := CoreLnGamma(Value);
      Result := CoreSub(temp, lna);
    end
    else
      CoreApproxLnGamma(Value);
  end;
end;

function TJclComplex.CLnGamma: TJclComplex;
var
  ResValue: TRectCoord;
begin
  ResValue := CoreLnGamma(RectCoord(Self));
  FCoord.X := ResValue.X;
  FCoord.Y := ResValue.Y;
  Result := Self;
end;

function TJclComplex.CNewLnGamma: TJclComplex;
var
  ResValue: TRectCoord;
begin
  ResValue := CoreLnGamma(RectCoord(Self));
  Result := TJclComplex.Create(ResValue.X, ResValue.Y, crRectangular);
  Result.FFracLen := FFracLen;
end;

function TJclComplex.CoreGamma(const Value: TRectCoord): TRectCoord;
var
  lnz: TRectCoord;
begin
  lnz := CoreLnGamma(Value);
  if lnz.X > 75.0 then
    Result := RectInfinity
  else
    if lnz.X < -200.0 then
      Result := RectZero
    else
      Result := CoreExp(lnz);
end;

function TJclComplex.CGamma: TJclComplex;
var
  ResValue: TRectCoord;
begin
  ResValue := CoreGamma(RectCoord(Self));
  FCoord.X := ResValue.X;
  FCoord.Y := ResValue.Y;
  Result := Self;
end;

function TJclComplex.CNewGamma: TJclComplex;
var
  ResValue: TRectCoord;
begin
  ResValue := CoreGamma(RectCoord(Self));
  Result := TJclComplex.Create(ResValue.X, ResValue.Y, crRectangular);
  Result.FFracLen := FFracLen;
end;

//=== miscellaneous ==========================================================

function TJclComplex.AbsoluteValue: Float;
begin
  Result := Sqrt(Sqr(FCoord.X) + Sqr(FCoord.Y));
end;

function TJclComplex.AbsoluteValue(const Coord: TRectCoord): Float;
begin
  Result := Sqrt(Sqr(Coord.X) + Sqr(Coord.Y));
end;

function TJclComplex.AbsoluteValueSqr: Float;
begin
  Result := Sqr(FCoord.X) + Sqr(FCoord.Y);
end;

function TJclComplex.AbsoluteValueSqr(const Coord: TRectCoord): Float;
begin
  Result := Sqr(Coord.X) + Sqr(Coord.Y);
end;

function TJclComplex.FormatExtended(const X: Float): string;
begin
  Result := FloatToStrF(X, ffFixed, FFracLen, FFracLen);
end;

procedure TJclComplex.SetFracLen(const X: Byte);
begin
  if X > MaxFracLen then
    FFracLen := MaxFracLen
  else
    FFracLen := X;
end;

function TJclComplex.GetRadius: Float;
begin
  FillCoords(crRectangular);
  Result := FCoord.R;
end;

function TJclComplex.GetAngle: Float;
begin
  FillCoords(crRectangular);
  Result := FCoord.Theta;
end;

function TJclComplex.NormalizeAngle(Value: Float): Float;
begin
  FillCoords(crRectangular);
  while Value > Pi do
    Value := Value - TwoPi;
  while Value < -Pi do
    Value := Value + TwoPi;
  Value := MiscalcSingle(Value);
  Result := Value;
end;

// History:

// $Log: JclComplex.pas,v $
// Revision 1.14  2005/03/08 16:10:07  marquardt
// standard char sets extended and used, some optimizations for string literals
//
// Revision 1.13  2005/03/08 08:33:15  marquardt
// overhaul of exceptions and resourcestrings, minor style cleaning
//
// Revision 1.12  2005/02/24 16:34:39  marquardt
// remove divider lines, add section lines (unfinished)
//
// Revision 1.11  2005/02/13 09:55:20  mthoma
// Fixed:  0000060: Don's use parameter 'Value' in trigonometric functions
//
// Revision 1.10  2004/10/17 20:25:21  mthoma
// style cleaning, adjusting contributors
//
// Revision 1.9  2004/10/12 17:21:54  rrossmair
// restore JclMath compatibility
//
// Revision 1.8  2004/09/16 19:47:32  rrossmair
// check-in in preparation for release 1.92
//
// Revision 1.7  2004/08/01 05:52:11  marquardt
// move constructors/destructors
//
// Revision 1.6  2004/07/28 18:00:49  marquardt
// various style cleanings, some minor fixes
//
// Revision 1.5  2004/05/05 00:04:10  mthoma
// Updated headers: Added donors as contributors, adjusted the initial authors, added cvs names
// when they were not obvious. Changed $data to $date where necessary,
//
// Revision 1.4  2004/04/06 04:53:18
// adapt compiler conditions, add log entry
//
// Revision 1.3  2004/03/23 08:54 rrossmair
// to work around D7 trial issues, $WEAKPACKAGEUNIT directives now depend on symbol in jedi.inc
// modification date comments replaced by $Id: JclComplex.pas,v 1.14 2005/03/08 16:10:07 marquardt Exp $ CVS key word
//
// Revision 1.2  2003/11/27 16:54 rrossmair
// removed unused JclSysUtils from uses clause
//
// Revision 1.1  2003/11/19 16:43 mthoma
// Initial upload.

end.