⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 graphmath.pas

📁 这是图形处理中常用的数学计算方法。比较全面
💻 PAS
📖 第 1 页 / 共 5 页
字号:
{矢量叉积}

function VectorCrossMult(const dPnt1, dPnt2: TRealPoint; Err: Double = ERROR7): Double;
var
  vc: Double;
begin
  vc := dPnt1.x * dPnt2.y - dPnt2.x * dPnt1.y;
  if abs(vc) < Err then
    Result := 0
  else
    Result := vc;
end;

{交换x1,x2的值}

procedure SwapValue(var x1, x2: Double);
var
  x: Double;
begin
  x := x1;
  x1 := x2;
  x2 := x;
end;

{交换x1,x2的值}

procedure SwapValue(var x1, x2: Integer); overload;
var
  x: Integer;
begin
  x := x1;
  x1 := x2;
  x2 := x;
end;

{交换d1,d2的值}

procedure SwapValue(var d1, d2: TRealPoint); overload;
var
  d: TRealPoint;
begin
  d := d1;
  d1 := d2;
  d2 := d;
end;

procedure SwapValue(var L1, L2: TLineRecord); overload;
var
  L: TLineRecord;
begin
  L := L1;
  L1 := L2;
  L2 := L;
end;

procedure SwapValue(var p1, p2: pointer); overload;
var
  p: pointer;
begin
  p := p1;
  p1 := p2;
  p2 := p;
end;

procedure SwapValue(var List: TList; I, J: Integer); overload;
var
  p: pointer;
begin
  p := List.Items[I];
  List.Items[I] := List.Items[J];
  List.Items[J] := p;
end;

procedure MaxToMin(var x1, x2: Double);
var
  temp: Double;
begin
  if RL(x1, x2) then
  begin
    temp := x1;
    x1 := x2;
    x2 := Temp;
  end
end;

procedure MinToMax(var x1, x2: Double);
var
  x: Double;
begin
  if RG(x1, x2) then
  begin
    x := x1;
    x1 := x2;
    x2 := x;
  end;
end;

function MaxV(const x1, x2: Integer): Integer;
begin
  if x1 > x2 then
    Result := x1
  else
    Result := x2;
end;

function MaxV(const x1, x2: Double): Double;
begin
  if RG(x1, x2) then
    Result := x1
  else
    Result := x2;
end;

function MaxV(const x1, x2, x3: Integer): Integer;
var
  x: Integer;
begin
  x := MaxV(x1, x2);
  Result := MaxV(x, x3);
end;

function MaxV(const x1, x2, x3: Double): Double;
var
  x: Double;
begin
  x := MaxV(x1, x2);
  Result := MaxV(x, x3);
end;

function MinV(const x1, x2: Integer): Integer; overload;
begin
  if x1 < x2 then
    Result := x1
  else
    Result := x2;
end;

function MinV(const x1, x2: Double): Double; overload;
begin
  if RL(x1, x2) then
    Result := x1
  else
    Result := x2;
end;

function MinV(const x1, x2, x3: Integer): Integer; overload;
var
  x: Integer;
begin
  x := MinV(x1, x2);
  Result := MinV(x, x3);
end;

function MinV(const x1, x2, x3: Double): Double; overload;
var
  x: Double;
begin
  x := MinV(x1, x2);
  Result := MinV(x, x3);
end;

{两矩阵相乘}

function MatrixMultiply(const T1, T2: TArr33): TArr33;
begin
  Result[1][1] := T1[1][1] * T2[1][1] + T1[1][2] * T2[2][1] + T1[1][3] * T2[3][1];
  Result[1][2] := T1[1][1] * T2[1][2] + T1[1][2] * T2[2][2] + T1[1][3] * T2[3][2];
  Result[1][3] := T1[1][1] * T2[1][3] + T1[1][2] * T2[2][3] + T1[1][3] * T2[3][3];

  Result[2][1] := T1[2][1] * T2[1][1] + T1[2][2] * T2[2][1] + T1[2][3] * T2[3][1];
  Result[2][2] := T1[2][1] * T2[1][2] + T1[2][2] * T2[2][2] + T1[2][3] * T2[3][2];
  Result[2][3] := T1[2][1] * T2[1][3] + T1[2][2] * T2[2][3] + T1[2][3] * T2[3][3];

  Result[3][1] := T1[3][1] * T2[1][1] + T1[3][2] * T2[2][1] + T1[3][3] * T2[3][1];
  Result[3][2] := T1[3][1] * T2[1][2] + T1[3][2] * T2[2][2] + T1[3][3] * T2[3][2];
  Result[3][3] := T1[3][1] * T2[1][3] + T1[3][2] * T2[2][3] + T1[3][3] * T2[3][3];
end;

{计算一元二次方程的根. 注:hvKey(0:无交点; 1:1个交点;2:2个交点)}

function EquationRadix(a, b, c: Double): TEquationRadix;
var
  dt, a2: Double;
begin
  if RE(a, 0) then
    Exit;

  dt := b * b - 4 * a * c;
  if RE(dt, 0) then
    Dt := 0;
  with Result do
    if dt >= 0 then
    begin
      a2 := a + a;
      b := -b;
      if RE(dt, 0) then
      begin
        x1 := b / a2;
        RadixNum := 1;
      end
      else
      begin
        dt := Sqrt(dt);
        x1 := (b - dt) / a2;
        x2 := (b + dt) / a2;
        RadixNum := 2;
      end;
    end
    else
      RadixNum := 0;
end;

{将角度调整到[0,2*pi)}

function NormalDegree(const Angle: TDegree): TDegree; // [0..360)
begin
  Result := Angle;
  while Result >= 360 do
    Result := Result - 360;
  while Result < 0 do
    Result := Result + 360;
end;

function NormalRadian(const Radian: TRadian): TRadian; //[0..2*pi)
begin
  Result := Radian;
  while Result >= 2 * pi do
    Result := Result - 2 * pi;
  while Result < 0 do
    Result := Result + 2 * pi;
end;

{求正弦,余弦}

function MyCos(Angle: TRadian): Double;
begin
  while Angle < 0 do
    Add(Angle, Pi * 2);
  while Angle > Pi * 2 do
    Sub(Angle, Pi * 2);
  if RE(Angle, PI12) or RE(Angle, PI32) then
    Result := 0
  else
    Result := Cos(Angle);
end;

function MySin(Angle: TRadian): Double; //参数:弧度
begin
  while Angle < 0 do
    Add(Angle, Pi * 2);
  while Angle > Pi * 2 do
    Sub(Angle, Pi * 2);
  if RE(Angle, 0) or RE(Angle, 2 * pi) then
    Result := 0
  else
    Result := Sin(Angle);
end;

{点的数组排序(从小到大)}

procedure SortPointByX(var dPntsArr: TRealPointArray); //按照x坐标
var
  I, Q, M, N: Integer;
begin
  N := High(dPntsArr);

  M := 0; {首次交换的范围是0至N }
  while M < N do
  begin
    Q := N; {Q用来记录此次交换的位置,每次初始值为N}
    for I := N downto M + 1 do {从此往前比较,找到最小的节点值冒泡}
    begin
      if RL(dPntsArr[I].x, dPntsArr[I - 1].x) then
      begin
        SwapValue(dPntsArr[I], dPntsArr[I - 1]);
        Q := I;
      end;
    end;
    M := Q; {一次交换发生位置互换的最后位置}
  end;
end;

procedure SortPointByY(var dPntsArr: TRealPointArray); //按照Y坐标
var
  I, Q, M, N: Integer;
begin
  N := High(dPntsArr);

  M := 0; {首次交换的范围是0至N}
  while M < N do
  begin
    Q := N; {Q用来记录此次交换的位置,每次初始值为N}
    for I := N downto M + 1 do {从此往前比较,找到最小的节点值冒泡}
    begin
      if RL(dPntsArr[I].y, dPntsArr[I - 1].y) then
      begin
        SwapValue(dPntsArr[I], dPntsArr[I - 1]);
        Q := I;
      end;
    end;
    M := Q; {一次交换发生位置互换的最后位置}
  end;
end;

procedure SortPoint(var dPntsArr: TRealPointArray); //如果X坐标不同,按X排序,否则按Y排序
var
  N: Integer;
begin
  N := High(dPntsArr);
  if N < 1 then
    exit;

  if RE(dPntsArr[0].x, dPntsArr[1].x) then
    SortPointByY(dPntsArr)
  else
    SortPointByX(dPntsArr);
end;

{对弧上的一些点排序(按照弧度从小到大)}

procedure SortArcPoint(var dPntsArr: TRealPointArray; OPnt: TRealPoint; R: Double);
var
  I, Q, M, N: Integer;
  dRadianArr: array of Double;
  TemAgl: TRadian;
begin
  N := High(dPntsArr);
  if N < 1 then
    exit;

  dRadianArr := nil;
  for I := 0 to N do
  begin
    TemAgl := LineAngle(OPnt, dPntsArr[I]);
    SetLength(dRadianArr, I + 1);
    dRadianArr[I] := TemAgl;
  end;

  if N = 1 then
  begin
    if RL(dRadianArr[1], dRadianArr[0]) then
      SwapValue(dPntsArr[1], dPntsArr[0]);
    exit;
  end;

  M := 0; {首次交换的范围是0至N -1}
  while M < N - 1 do
  begin
    Q := N - 1; {Q用来记录此次交换的位置,每次初始值为N-1}
    for I := N - 1 downto M + 1 do {从此往前比较,找到最小的节点值冒泡}
    begin
      if RL(dRadianArr[I], dRadianArr[I - 1]) then
      begin
        SwapValue(dRadianArr[I], dRadianArr[I - 1]);
        SwapValue(dPntsArr[I], dPntsArr[I - 1]);
        Q := I;
      end;
    end;
    M := Q; {一次交换发生位置互换的最后位置}
  end;
end;

//==========================判断=================================>>

{比较实数大小关系R:实数;E:等于;L:小于;G:大于;}

function RE(const a, b: Double; Err: Double = ERROR7): Boolean;
begin
  Result := Abs(a - b) <= Err;
end;

function RL(const a, b: Double; Err: Double = ERROR7): Boolean;
begin

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -