📄 graphmath.pas
字号:
{矢量叉积}
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 + -