jmaths.pas

定点数函数集

unit JMaths;
{$WARNINGS OFF}

interface
uses Windows, Messages, SysUtils, Classes, Graphics, Controls, StdCtrls,
     Math, JPubTypes;

procedure CalcPiEx(var PiStr: string; DecimalDigits: WORD);
procedure CalcPi1K(Memo: TMemo);
function CalcPi: double;
function SamePoint(PT1,PT2: TPoint): boolean;
function ArcTangente(ax, ay : integer) : double;
function ArcTangent(ax, ay : integer) : double;
function Arc2Tangent(ax, ay : double) : double; overload;
function Arc2Tangent(ax, ay : Longint) : double; overload;
function Arc2TangentEx(ax, ay : integer) : double;
function ArcTangentScreen(ax, ay : integer): double;
function ArcAngle180(ax, ay : integer) : double;
function ArcAngle360(ax, ay : integer) : double;
function AngleToRadian(Value: double): double;
function RadianToAngle(Value: double): double;
function RadianToAngle360(Value: double): double;
function Calc2PAngle(p1,p2: TPoint): double;
function Calc2PAngleFollowPoint(Org,Pt1Str,Pt1Cur,Pt2Str: TPoint): TPoint;
function Calc2PRadiusFollowPoint(Org,Pt1Cur,Pt2Str: TPoint): TPoint;
function Calc2PFollowPoint(Org,Pt1Str,Pt1Cur,Pt2Str: TPoint; AngleFollow,
                           RadiusFollow: boolean): TPoint;
function MapFXY(fxy: FIXED): Longint;
function IntFromFixed(f: FIXED): Longint;
function Int2Fix(x: Longint): FIXED;
function Fix2Int(x: FIXED): Longint;
function FixAdd(a,b: FIXED): FIXED;
function FixSub(a,b: FIXED): FIXED;
function FixRound(x :Fixed): Longint;
function FixMul(x, y :Fixed): Fixed;
function FixDiv(x, y: Fixed): Fixed;
function FixAverageA(x,y: FIXED): FIXED;
function FixAverageB(x,y: FIXED): FIXED;
function Float2Fix(x: double): FIXED;
function Fix2Float(Value: FIXED): double;

function JFixToInt(x: Longint): Longint;
function JIntToFix(x : Longint): Longint;
function JFixMul(x,y : Longint): Longint;
function JFixDiv(x,y : Longint): Longint;
function JFixSqrt(n : Longint): Longint;
function JFixRound(n : Longint): Longint;
function JFixSin(f: Longint): Longint;
function JFixCos(f: Longint): Longint;
function JFixTan(f : Longint): Longint;
function JFixArcTan(f : Longint): Longint;
function JFixArcSin(f : Longint): Longint;
function JFixArcCos(f : Longint): Longint;
function JFixExp(x : Longint): Longint;
function JFixLn(x : Longint): Longint;
function JFixIntersects(ax0,ay0,ax1,ay1,bx0,by0,bx1,by1: Longint): boolean;

function Float2_Fix(x: double): FIXED;
function Fix_2Float(Value: FIXED): double;
function FIX_FRAC(Value : FIXED): Longint;
function Fix_Scale: Longint;
function FIX_SCALEF: double;
function FIX_SCALEF_: double;
function Fix_Mult(a,b: FIXED): FIXED;
function Fix_Div_(a,b: FIXED): FIXED;
function Fix_Sqrt(Num : FIXED): FIXED;

// ----------------------- Geometry  function --------------------------------

function Calc2PPixelLength(Pt1,Pt2 : TPoint): Longint;
function Calc2PLength(Pt1,Pt2: TFPoint): double; overload;
function Calc2PLength(Pt1,Pt2: TPoint): double; overload;
function Calc2PAngleEx(Pt1,Pt2: TFPoint): double; overload;
function Calc2PAngleEx(Pt1,Pt2: TPoint): double; overload;
function Calc2PRadian(Pt1,Pt2: TPoint): double;
function CalcVerticalPoint(Pt1,Pt2,Pt3: TFPoint): TFPoint;

// -------------------------- Calc Contour ------------------------------------
procedure CalcContour(Memo: TMemo;
                      D: TContourMatrix ; // 2D - Data field
                      ilb,iub, // west - east ilb lower bound
                      jlb,jub : Integer; // iub upper bound north -
                                         // south jlb lower bound jub upper bound
                      x : TContourVector; // coord. vector west - east
                      y : TContourVector; // coord. vector north - south
                      nc: Integer; // nc number of cut levels
                      z : TContourVector); // values of cut levels
procedure CalcContourTest(Memo : TMemo);



implementation
uses Forms, JTreasury;

var
InCalc : boolean = false;

procedure CalcPiEx(var PiStr: string; DecimalDigits: WORD);
var
i : Longint;
z : array of byte;
x : array of byte;
a,b,c,d,Run,Cnt : Longint;
ArraySize : Longint;
DispSize  : Longint;
begin
 if inCalc then exit;
 InCalc := true;
 DispSize  := DecimalDigits + 2;
 ArraySize := DispSize + 10;
 SetLength(z,ArraySize);
 SetLength(x,ArraySize);
 a := 1; b := 3; Run := 1;  Cnt := 0;
 for i := 0 to ArraySize - 1 do z[i] := 0;
 for i := 0 to ArraySize - 1 do x[i] := 0;
 x[1] := 2;
 z[1] := 2;
 while longbool(Run) and ((Cnt + 1) < 200000000) do begin
  inc(Cnt);
  //z*=a;
  d := 0;
  for i := ArraySize - 1 downto 1 do begin
   c := z[i] * a + d;
   z[i] := c mod 10;
   d := c div 10;
   Application.ProcessMessages;
  end;
  //z/=b;
  d := 0;
  for i := 0 to ArraySize - 1 do begin
   c := z[i] + d * 10;
   z[i] := c div b;
   d := c mod b;
   Application.ProcessMessages;
  end;
  //x+=z;
  Run := 0;
  for i := ArraySize - 1 downto 1 do begin
   c := x[i] + z[i];
   x[i] := c mod 10;
   inc(x[i - 1],c div 10);
   inc(Run,z[i]);
   Application.ProcessMessages;
  end;
  inc(a);
  inc(b,2);
 end;
 PiStr := '';
 for i := 1 to DispSize - 1 do PiStr := PiStr + char($30 + x[i]);
 SetLength(z,0);
 SetLength(x,0);
 InCalc := false;
end;

procedure CalcPi1K(Memo: TMemo);
const
CARRAYSIZE = 1010;
CDISPSIZE = 1000;
var
i,ii : Longint;
x : array[0..CARRAYSIZE - 1] of byte;
z : array[0..CARRAYSIZE - 1] of byte;
a,b,c,d,Run,Cnt : Longint;
DispStr : string;
begin
 if not Assigned(Memo) then exit;
 a := 1; b := 3; Run := 1;  Cnt := 0;
 FillMemory(@x,CARRAYSIZE,0);
 FillMemory(@z,CARRAYSIZE,0);
 x[1] := 2;
 z[1] := 2;
 while longbool(Run) and ((Cnt + 1) < 200000000) do begin
  inc(Cnt);
  //z*=a;
  d := 0;
  for i := CARRAYSIZE - 1 downto 1 do begin
   c := z[i] * a + d;
   z[i] := c mod 10;
   d := c div 10;
  end;
  //z/=b;
  d := 0;
  for i := 0 to CARRAYSIZE - 1 do begin
   c := z[i] + d * 10;
   z[i] := c div b;
   d := c mod b;
  end;
  //x+=z;
  Run := 0;
  for i := CARRAYSIZE - 1 downto 1 do begin
   c := x[i] + z[i];
   x[i] := c mod 10;
   inc(x[i - 1],c div 10);
   inc(Run,z[i]);
  end;
  inc(a);
  inc(b,2);
 end;
 Memo.Clear;
 Memo.Lines.Add('计算了' + IntToStr(Cnt) + '次');
 Memo.Lines.Add('Pi = ' + IntToStr(x[0]) + IntToStr(x[1]) + '.');
 DispStr := '';
 ii := 0;
 for i := 0 to CDISPSIZE - 1 do begin
  if ii < 74 then inc(ii) else begin
   Memo.Lines.Add(DispStr);
   DispStr := '';
   ii := 1;
  end;
  DispStr := DispStr + char($30 + x[i + 2]);
 end;
 if DispStr <> '' then Memo.Lines.Add(DispStr);
end;

function CalcPi: double;
var
x,z : double;
a,b : Longint;
begin
 x := 2;
 z := 2;
 a := 1;
 b := 3;
 while z > 1e-15 do begin // 0.000000000000001
  z := z * a / b;
  x := x + z;
  inc(a);
  inc(b,2);
 end;
 result := x;
end;

function SamePoint(PT1,PT2: TPoint): boolean;
begin
 result := Int64(PT1) = Int64(PT2);
end;

function ArcTangente(ax, ay : integer): double;  // = angle 0 - 270 .. -90 - 0
var
symetrie : boolean;
wx, wy : double;
begin
 if ax < 0 then symetrie := true else symetrie := false;
 wx :=  abs(ax);
 wy := -ay;
 if wx < 0.001 then begin { avoid zero divide }
  if wy < 0 then result := pi + Pi / 2 else result := Pi / 2;
 end else begin
  result := arctan(wy / wx);
  if symetrie then result := pi - result;
 end;
end;

function ArcTangent(ax, ay : integer): double; //正向 = angle -180 - +180
var
T2 : double;
begin
 T2 := ArcTan2(ax,ay);
 if T2 <= -PiDivide2 then result := PiDiv2AddPi - Abs(T2)
                     else result := T2 - PiDivide2;
end;

function ArcTangentScreen(ax, ay : integer): double; //正向 = angle -180 - +180
var
T2 : double;
begin
 T2 := ArcTan2(ax,ay);
 // 顺时针转二分之一 Pi ( =90度 )
 if T2 <= -PiDivide2 then T2 := PiDiv2AddPi - Abs(T2)
                     else T2 := T2 - PiDivide2;
 // 上下翻转符合计算机屏幕坐标 X=左负右正 Y=上负下正
 if T2 < 0 then result := Abs(T2) else
 if (T2 + 0.000001) < Pi then result := -T2 // < Pi
                         else result := T2; // = Pi
end;

function Arc2Tangent(ax, ay : double): double; overload; //正向 = angle 0 - 360
begin
 result := ArcTan2(ax,ay) - PiDivide2;
 if result < 0 then result := PiMultiply2 - Abs(result);
end;

function Arc2Tangent(ax, ay : Longint): double; overload; //正向 = angle 0 - 360
begin
 result := ArcTan2(ax,ay) - PiDivide2;
 if result < 0 then result := PiMultiply2 - Abs(result);
end;

function Arc2TangentEx(ax, ay : integer): double; //反向 = angle 0 - 360
var
T2 : double;
begin
 T2 := ArcTan2(ax,ay) - PiDivide2;
 if T2 > 0 then result := PiMultiply2 - T2
           else result := Abs(T2);
end;

function ArcAngle180(ax, ay : integer) : double;
begin
 result := ArcTangent(ax,ay) * 180 / Pi;
end;

function ArcAngle360(ax, ay : integer) : double;
begin
 result := Arc2Tangent(ax,ay) * 180 / Pi;
end;

function AngleToRadian(Value: double): double;
begin
 //弧度= 角度* PI / 180
 result := Value * Pi / 180;
end;

function RadianToAngle(Value: double): double;
begin
 //角度= 弧度* 180 / PI
 result := Value * 180 / PI;
end;

function RadianToAngle360(Value: double): double;
begin
 //角度= 弧度* 180 / PI
 result := (Round(Value * 180 / PI) + 360) mod 360;
end;

function Calc2PAngle(p1,p2: TPoint): double;
var
Ang : double;
VX : double;
begin
 VX := p2.X - p1.X + 0.00001;
 Ang := ArcTan((p2.Y - p1.Y) / VX) * AngleQuotiety;
 if (p2.Y < p1.Y) and (p2.X > p1.X) then
 result :=  Ang
 else
 if ((p2.Y < p1.Y) and (p2.X < p1.X)) or ((p2.Y > p1.Y) and (p2.X > p1.X)) then
 result := Ang + 180
 else
 result := Ang + 360;
 //就是反正切了
end;

function Calc2PAngleFollowPoint(Org,Pt1Str,Pt1Cur,Pt2Str: TPoint): TPoint;
var
Pt1StrAngle : double;
Pt1CurAngle : double;
Pt2StrAngle : double;
IncAngle : double;
rox : double;
roy : double;
ro : double;
NewAngle : double;
begin
 Pt1StrAngle := ArcTangente(Pt1Str.X - Org.X, Pt1Str.Y - Org.Y);
 Pt1CurAngle := ArcTangente(Pt1Cur.X - Org.X, Pt1Cur.Y - Org.Y);
 Pt2StrAngle := ArcTangente(Pt2Str.X - Org.X, Pt2Str.Y - Org.Y);
 IncAngle := Pt1CurAngle - Pt1StrAngle;
 NewAngle := Pt2StrAngle + IncAngle;
 rox := Pt2Str.X - Org.X;
 roy := Pt2Str.Y - Org.Y;
 ro := sqrt(sqr(rox) + sqr(roy));
 Result.x := Org.X + round(ro * cos(NewAngle));
 Result.y := Org.Y - round(ro * sin(NewAngle));
end;

function Calc2PRadiusFollowPoint(Org,Pt1Cur,Pt2Str: TPoint): TPoint;
var
Pt2StrAngle : double;
rox : double;
roy : double;
ro : double;
begin
 Pt2StrAngle := ArcTangente(Pt2Str.X - Org.X, Pt2Str.Y - Org.Y);
 rox := Pt1Cur.X - Org.X;
 roy := Pt1Cur.Y - Org.Y;
 ro := sqrt(sqr(rox) + sqr(roy));
 Result.x := Org.X + round(ro * cos(Pt2StrAngle));
 Result.y := Org.Y - round(ro * sin(Pt2StrAngle));
end;

function Calc2PFollowPoint(Org,Pt1Str,Pt1Cur,Pt2Str: TPoint; AngleFollow,RadiusFollow: boolean): TPoint;
var
Pt1StrAngle : double;
Pt1CurAngle : double;
Pt2StrAngle : double;
IncAngle : double;
rox : double;
roy : double;
ro : double;
NewAngle : double;
begin
 if (not AngleFollow) and (not RadiusFollow) then begin
  result := Pt2Str;
  exit;
 end;
 Pt2Str.X := Pt2Str.X;
 Pt2Str.Y := Pt2Str.Y;
// Pt2StrAngle := ArcTangent(Pt2Str.X - Org.X, Pt2Str.Y - Org.Y);
 Pt2StrAngle := ArcTangentScreen(Pt2Str.X - Org.X, Pt2Str.Y - Org.Y);
 if AngleFollow then begin
  Pt1StrAngle := ArcTangentScreen(Pt1Str.X - Org.X, Pt1Str.Y - Org.Y);
  Pt1CurAngle := ArcTangentScreen(Pt1Cur.X - Org.X, Pt1Cur.Y - Org.Y);
  IncAngle := Pt1CurAngle - Pt1StrAngle;
  NewAngle := Pt2StrAngle + IncAngle
 end else NewAngle := Pt2StrAngle;
 if RadiusFollow then begin
  rox := Pt1Cur.X - Org.X;
  roy := Pt1Cur.Y - Org.Y;
 end else begin
  rox := Pt2Str.X - Org.X;
  roy := Pt2Str.Y - Org.Y;
 end;
 ro := sqrt(sqr(rox) + sqr(roy));
// ArcTangentScreen :
 Result.x := Org.X + round(ro * cos(NewAngle));
 Result.y := Org.Y + round(ro * sin(NewAngle));
// ArcTangent :
// Result.x := Org.X + round(ro * cos(Pt2StrAngle));
// Result.y := Org.Y - round(ro * sin(Pt2StrAngle));
end;