GIS基本函数类库Delphi代码
关注我的微信公众号,学习更多
unit utgispub; interface uses Math; type uPoint = record X, Y: Double; end; uPoints = array of uPoint; //方位角: 输入线段(X1,Y1)-(X2,Y2); 返回方位角 function GetLineAngle(X1, Y1, X2, Y2: Double): Double; //长度: 输入线段(X1,Y1)-(X2,Y2); 返回长度 function GetLineLength(X1, Y1, X2, Y2: Double): Double; //顺时针角度: 输入三点(X1,Y1)、(X2,Y2)、(X3,Y3); 返回True(顺时针)或False(逆时针) function IsClockwise(X1, Y1, X2, Y2, X3, Y3: Double): Boolean; //顺时针: 输入线段(X1,Y1)-(X2,Y2)、(X3,Y3)-(X4,Y4); 返回True(顺时针)或False(逆时针) function IsClockwiseEx(X1, Y1, X2, Y2, X3, Y3, X4, Y4: Double): Boolean; //点到直线距离: 输入线段(X1,Y1)-(X2,Y2)、点(X3,Y3); 返回距离 function GetVertDist(X1, Y1, X2, Y2, X3, Y3: Double): Double; //垂足: 输入线段(X1,Y1)-(X2,Y2)、点(X3,Y3); 输出垂足(X,Y) procedure GetVertXY(X1, Y1, X2, Y2, X3, Y3: Double; var X, Y: Double); //线段端点(X2,Y2)处垂线上指定长度的点 //输入线段(X1,Y1)-(X2,Y2)、距离d; 输出点(LX,LY)、(RX,RY); 若线段端点重合返回False function GetVertDistXY(X1, Y1, X2, Y2, d: Double; var LX, LY, RX, RY: Double): Boolean; //线段端点(X2,Y2)方向延长线上指定长度的点 //输入线段(X1,Y1)-(X2,Y2)、距离d; 输出点(LX,LY)、(RX,RY); 若线段端点重合返回False function GetExtendDistXY(X1, Y1, X2, Y2, d: Double; var LX, LY, RX, RY: Double): Boolean; //对称点:输入点(X1,Y1)、(X0,Y0); 输出点(X1,Y1)关于(X0,Y0)的对称点 procedure GetSymmetricXY(X1, Y1, X0, Y0: Double; var X, Y: Double); //两直线夹角: 输入线段(X1,Y1)-(X2,Y2)、(X3,Y3)-(X4,Y4); 返回夹角(<180) function GetIntersectAngle(X1, Y1, X2, Y2, X3, Y3, X4, Y4: Double): Double; //判断两直线有无交点: 输入线段(X1,Y1)-(X2,Y2)、(X3,Y3)-(X4,Y4); 若两线段有交点返回True function IsLineIntersect(X1, Y1, X2, Y2, X3, Y3, X4, Y4: Double): Boolean; //两直线交点: 输入线段(X1,Y1)-(X2,Y2)、(X3,Y3)-(X4,Y4); 输出交点(X,Y); 若两线段平行返回False function GetIntersectXY(X1, Y1, X2, Y2, X3, Y3, X4, Y4: Double; var X, Y: Double): Boolean; //过点作线段的平行线: 输入线段(X1,Y1)-(X2,Y2)、点(X3,Y3); 输出平行线(LX,LY)-(RX,RY); 若线段端点重合返回False function GetParaLineByPoint(X1, Y1, X2, Y2, X3, Y3: Double; var LX, LY, RX, RY: Double): Boolean; //作线段某侧一定距离的平行线: 输入线段(X1,Y1)-(X2,Y2)、距离Dist、位置FlagLeft; 输出平行线(LX,LY)-(RX,RY); 若线段端点重合返回False function GetParaLineByDist(X1, Y1, X2, Y2, Dist: Double; FlagLeft: Boolean; var LX, LY, RX, RY: Double): Boolean; //作连续线某侧一定距离的平行线: 输入连续线InPts、距离Dist、位置FlagLeft; 输出平行连续线OutPts; 若线段端点重合返回False function GetParaLineByDistEx(var InPts: uPoints; Dist: Double; FlagLeft: Boolean; var OutPts: uPoints): Boolean; //作两线段的中心线: 输入线段(X1,Y1)-(X2,Y2)、(X3,Y3)-(X4,Y4); 输出平行线(LX,LY)-(RX,RY); 若线段端点重合返回False function GetCentreline(X1, Y1, X2, Y2, X3, Y3, X4, Y4: Double; var LX, LY, RX, RY: Double): Boolean; //作线段的参考线: 输入线段(X1,Y1)-(X2,Y2)、角度(-360~360); 输出与已知线段成已知角度的线段的另一端点(X,Y); 若线段端点重合返回False function GetAngleLine(X1, Y1, X2, Y2: Double; angle: Double; var X, Y: Double): Boolean; //点在直线内侧: 输入线段(X1,Y1)-(X2,Y2)、点(X3,Y3); 若点在线段内侧返回True,否则返回False function IsPointInsideLine(X1, Y1, X2, Y2, X3, Y3: Double): Boolean; //点在直线上: 输入线段(X1,Y1)-(X2,Y2)、点(X3,Y3); 若点在线段上返回True,否则返回False function IsPointOnLine(X1, Y1, X2, Y2, X3, Y3: Double): Boolean; //点在相交区域:输入线段(X1,Y1)-(X2,Y2)、(X3,Y3)-(X4,Y4)、点(X,Y); 输出点所在相交区域的端点(LX,LY)、(RX,RY) //若线段相交返回True,否则返回False function GetIntersectRegion(X1, Y1, X2, Y2, X3, Y3, X4, Y4, X, Y: Double; var X0, Y0, LX, LY, RX, RY: Double): Boolean; //梯形顶点:输入方向线段(X1,Y1)-(X2,Y2)、(X3,Y3)-(X4,Y4)、给定面积A; //输出梯形顶点(LX1,LY1)、(LX2,LY2)和(RX1,RY1)、(RX2,RY2), 若梯形存在返回True,否则返回False function GetTrapezoidNodes(X1, Y1, X2, Y2, X3, Y3, X4, Y4, A: Double; var LX1, LY1, RX1, RY1, LX2, LY2, RX2, RY2: Double): Boolean; //三角形重心(垂直平分线交点): 输入点(X1,Y1)、(X2,Y2)、(X3,Y3), 若不在一直线上输出重心(X,Y),返回True,否则返回False function GetWeightCenter(X1, Y1, X2, Y2, X3, Y3: Double; var X, Y: Double): Boolean; //过三点作弧1(用于MapX): 输入三点(X1,Y1)、(X2,Y2)、(X3,Y3), //输出(X1,Y1)-(X3,Y3)之中点到以(X1,Y1)、(X3,Y3)为切点的圆弧切线交点的距离Dist以及夹角常数Angle(90°/270°) //若三点共线无法形成圆弧返回False, 否则返回True function GetArcBy3PointsMapX(X1, Y1, X2, Y2, X3, Y3: Double; var Angle, Dist: Double): Boolean; //过三点作弧1(折线成弧): 输入三点(X1,Y1)、(X2,Y2)、(X3,Y3), //输出圆心(X0,Y0)及圆心角Angle(-360~360);若三点共线无法形成圆弧返回False, 否则返回True function GetArcBy3PointsEx(X1, Y1, X2, Y2, X3, Y3: Double; var X0, Y0, Angle: Double): Boolean; //指定起止点及圆心作弧: 输入起止点(X1,Y1)、(X2,Y2)、参考点(X3,Y3)、圆心(X0,Y0), //输出圆心角Angle(-360~360);若无法形成圆弧返回False, 否则返回True function GetArcByCenter(X1, Y1, X2, Y2, X3, Y3, X0, Y0: Double; var Angle: Double): Boolean; //指定起止点及半径作弧: 输入起止点(X1,Y1)、(X2,Y2)、参考点(X3,Y3)、半径Radius, //输出圆心(X0,Y0)及圆心角Angle(-360~360);若无法形成圆弧返回False, 否则返回True function GetArcByRadius(X1, Y1, X2, Y2, X3, Y3, Radius: Double; var X0, Y0, Angle: Double): Boolean; //夹角过渡弧1: 输入两线段(X1,Y1)-(X2,Y2)、(X3,Y3)-(X4,Y4)与圆弧半径r, //输出延长/截断的两线段(LX1,LY1)-(LX2,LY2)(切点)、(RX1,RY1)-(RX2,RY2)(切点)与圆心(X0,Y0) //若线段无夹角或半径不合适返回False; 否则返回True function GetInterimArc(X1, Y1, X2, Y2, X3, Y3, X4, Y4, r: Double; var LX1, LY1, LX2, LY2, RX1, RY1, RX2, RY2, X0, Y0: Double): Boolean; //夹角过渡弧2: 输入两线段(X1,Y1)-(X2,Y2)、(X3,Y3)-(X4,Y4)、保留区域标识点(FX,FY)与圆弧半径r, //输出延长/截断的两线段(LX1,LY1)-(LX2,LY2)、(RX1,RY1)-(RX2,RY2)与圆心(X0,Y0) //若线段无夹角或半径不合适返回False; 否则返回True function GetInterimArcEx(X1, Y1, X2, Y2, X3, Y3, X4, Y4, FX, FY, r: Double; var LX1, LY1, LX2, LY2, RX1, RY1, RX2, RY2, X0, Y0: Double): Boolean; //夹角弧3(用于MapX): 输入两线段(X1,Y1)-(X2,Y2)、(X3,Y3)-(X4,Y4)与圆弧半径r, //输出延长/截断的两线段(LX1,LY1)-(LX2,LY2)、(RX1,RY1)-(RX2,RY2); //(LX2,LY2)-(RX2,RY2)之中点到以(LX2,LY2)、(RX2,RY2)为切点的圆弧切线交点的距离Dist以及夹角常数Angle(90°/270°) //若线段无夹角或半径不合适返回False; 否则返回True function GetInterimArcMapX(X1, Y1, X2, Y2, X3, Y3, X4, Y4, r: Double; var LX1, LY1, LX2, LY2, RX1, RY1, RX2, RY2, Angle, Dist: Double): Boolean; implementation //方位角: 输入线段(X1,Y1)-(X2,Y2); 返回方位角 function GetLineAngle(X1, Y1, X2, Y2: Double): Double; var k: Double; begin if (X2 = X1) then //垂线 if (Y2 > Y1) then Result := 90 else Result := 270 else begin k := (Y2 - Y1) / (X2 - X1); k := ArcTan(k) * 180 / Pi; if X2 < X1 then //二、三象限 Result := k + 180 else if Y2 >= Y1 then //一象限 Result := k else //四象限 Result := k + 360; end; end; //长度: 输入线段(X1,Y1)-(X2,Y2); 返回长度 function GetLineLength(X1, Y1, X2, Y2: Double): Double; begin Result := Sqrt(Sqr(X2 - X1) + Sqr(Y2 - Y1)); end; //顺时针角度: 输入三点(X1,Y1)、(X2,Y2)、(X3,Y3); 返回True(顺时针)或False(逆时针) function IsClockwise(X1, Y1, X2, Y2, X3, Y3: Double): Boolean; var angle1, angle2: Double; begin angle1 := GetLineAngle(X2, Y2, X1, Y1); angle2 := GetLineAngle(X2, Y2, X3, Y3); if angle2 < angle1 then angle2 := angle2 + 360; Result := (angle2 - angle1 >= 180); end; //顺时针: 输入线段(X1,Y1)-(X2,Y2)、(X3,Y3)-(X4,Y4); 返回True(顺时针)或False(逆时针) function IsClockwiseEx(X1, Y1, X2, Y2, X3, Y3, X4, Y4: Double): Boolean; var angle1, angle2: Double; begin angle1 := GetLineAngle(X1, Y1, X2, Y2); angle2 := GetLineAngle(X3, Y3, X4, Y4); if angle2 < angle1 then angle2 := angle2 + 360; Result := (angle2 - angle1 >= 180); end; //点到直线距离: 输入线段(X1,Y1)-(X2,Y2)、点(X3,Y3); 返回距离 function GetVertDist(X1, Y1, X2, Y2, X3, Y3: Double): Double; var k: Double; begin if (Abs(X2 - X1) < 0.0001) and (Abs(Y2 - Y1) < 0.0001) then //线段端点重合 Result := GetLineLength(X1, Y1, X3, Y3) else begin k := GetLineLength(X1, Y1, X2, Y2); Result := Abs((Y2 - Y1) * (X3 - X1) - (X2 - X1) * (Y3 - Y1)) / k; end; end; //垂足: 输入线段(X1,Y1)-(X2,Y2)、点(X3,Y3); 输出垂足(X,Y) procedure GetVertXY(X1, Y1, X2, Y2, X3, Y3: Double; var X, Y: Double); var k: Double; begin if (Abs(X2 - X1) < 0.0001) and (Abs(Y2 - Y1) < 0.0001) then begin X := X1; Y := Y1; end else begin k := Sqr(X2 - X1) + Sqr(Y2 - Y1); X := (Sqr(Y2 - Y1) * X1 + Sqr(X2 - X1) * X3 + (Y2 - Y1) * (Y3 - Y1) * (X2 - X1)) / k; Y := (Sqr(X2 - X1) * Y1 + Sqr(Y2 - Y1) * Y3 + (Y2 - Y1) * (X3 - X1) * (X2 - X1)) / k; end; end; //线段端点(X2,Y2)处垂线上指定长度的点 //输入线段(X1,Y1)-(X2,Y2)、距离d; 输出点(LX,LY)、(RX,RY); 若线段端点重合返回False function GetVertDistXY(X1, Y1, X2, Y2, d: Double; var LX, LY, RX, RY: Double): Boolean; var k: Double; begin if (Abs(X2 - X1) < 0.0001) and (Abs(Y2 - Y1) < 0.0001) then Result := False else begin k := GetLineLength(X1, Y1, X2, Y2); LX := X2 + (d * (Y2 - Y1)) / k; LY := Y2 - (d * (X2 - X1)) / k; RX := X2 - (d * (Y2 - Y1)) / k; RY := Y2 + (d * (X2 - X1)) / k; Result := True; end; end; //线段端点(X2,Y2)方向延长线上指定长度的点 //输入线段(X1,Y1)-(X2,Y2)、距离d; 输出点(LX,LY)、(RX,RY); 若线段端点重合返回False function GetExtendDistXY(X1, Y1, X2, Y2, d: Double; var LX, LY, RX, RY: Double): Boolean; var k: Double; begin if (Abs(X2 - X1) < 0.0001) and (Abs(Y2 - Y1) < 0.0001) then Result := False else begin k := GetLineLength(X1, Y1, X2, Y2); LX := X2 + (d * (X2 - X1)) / k; LY := Y2 + (d * (Y2 - Y1)) / k; RX := X2 - (d * (X2 - X1)) / k; RY := Y2 - (d * (Y2 - Y1)) / k; Result := True; end; end; //对称点:输入点(X1,Y1)、(X0,Y0); 输出点(X1,Y1)关于(X0,Y0)的对称点 procedure GetSymmetricXY(X1, Y1, X0, Y0: Double; var X, Y: Double); begin X := X0 * 2 - X1; Y := Y0 * 2 - Y1; end; //两直线夹角: 输入线段(X1,Y1)-(X2,Y2)、(X3,Y3)-(X4,Y4); 返回夹角(<180) function GetIntersectAngle(X1, Y1, X2, Y2, X3, Y3, X4, Y4: Double): Double; var a, b, angle: Double; begin a := GetLineAngle(X1, Y1, X2, Y2); b := GetLineAngle(X3, Y3, X4, Y4); angle := Abs(b - a); if angle > 180 then Result := 360 - angle else Result := angle; end; //过点作线段的平行线: 输入线段(X1,Y1)-(X2,Y2)、点(X3,Y3); 输出平行线(LX,LY)-(RX,RY); 若线段端点重合返回False function GetParaLineByPoint(X1, Y1, X2, Y2, X3, Y3: Double; var LX, LY, RX, RY: Double): Boolean; var tX1, tY1, tX2, tY2: Double; d: Double; begin if (Abs(X2 - X1) < 0.0001) and (Abs(Y2 - Y1) < 0.0001) then Result := False else begin d := GetVertDist(X1, Y1, X2, Y2, X3, Y3); GetVertDistXY(X2, Y2, X1, Y1, d, LX, LY, tX1, tY1); GetVertDistXY(X1, Y1, X2, Y2, d, tX2, tY2, RX, RY); if GetVertDist(LX, LY, RX, RY, X3, Y3) > 0.001 then begin LX := tX1; LY := tY1; RX := tX2; Ry := tY2; end; Result := True; end; end; //作线段某侧一定距离的平行线: 输入线段(X1,Y1)-(X2,Y2)、距离Dist、位置FlagLeft; 输出平行线(LX,LY)-(RX,RY); 若线段端点重合返回False function GetParaLineByDist(X1, Y1, X2, Y2, Dist: Double; FlagLeft: Boolean; var LX, LY, RX, RY: Double): Boolean; var tX1, tY1, tX2, tY2: Double; Clockwise: Boolean; begin if (Abs(X2 - X1) < 0.0001) and (Abs(Y2 - Y1) < 0.0001) then //端点重合 Result := False else begin GetVertDistXY(X2, Y2, X1, Y1, Dist, LX, LY, tX1, tY1); GetVertDistXY(X1, Y1, X2, Y2, Dist, tX2, tY2, RX, RY); Clockwise := IsClockwise(X1, Y1, X2, Y2, RX, RY); //左边即(X1,Y1)-(X2,Y2)与平行线上任一点形成的角呈逆时针 if (FlagLeft and Clockwise) or (not FlagLeft and not Clockwise) then begin LX := tX1; LY := tY1; RX := tX2; Ry := tY2; end; Result := True; end; end; //作连续线某侧一定距离的平行线: 输入连续线InPts、距离Dist、位置FlagLeft; 输出平行连续线OutPts; 若线段端点重合返回False function GetParaLineByDistEx(var InPts: uPoints; Dist: Double; FlagLeft: Boolean; var OutPts: uPoints): Boolean; var X1, Y1, X2, Y2, X3, Y3, X4, Y4, X, Y: Double; i, j, k: Integer; begin result:=False; if Length(InPts) < 2 then //少于两点 Result := False else if (Length(InPts) = 2) and (Abs(InPts[1].X - InPts[0].X) < 0.0001) and (Abs(InPts[1].Y - InPts[0].Y) < 0.0001) then //端点重合 Result := False else if Dist < 0 then //间距不合适 Result := False else if Dist < 0.00001 then //复制 begin SetLength(OutPts, Length(InPts)); for i := 0 to Length(InPts) - 1 do begin OutPts[i].X := InPts[i].X; OutPts[i].y := InPts[i].Y; end; end else //平行线 begin //first paraline //顺时针->线段右边的平行线 GetParaLineByDist(InPts[0].X, InPts[0].Y, InPts[1].X, InPts[1].Y, Dist, FlagLeft, X1, Y1, X2, Y2); SetLength(OutPts, 2); OutPts[0].X := X1; OutPts[0].Y := Y1; OutPts[1].X := X2; OutPts[1].Y := Y2; //Other paralines for i := 1 to Length(InPts) - 2 do //point begin //平行线 GetParaLineByDist(InPts[i].X, InPts[i].Y, InPts[i + 1].X, InPts[i + 1].Y, Dist, FlagLeft, X3, Y3, X4, Y4); while True do begin X1 := OutPts[Length(OutPts) - 2].X; Y1 := OutPts[Length(OutPts) - 2].Y; X2 := OutPts[Length(OutPts) - 1].X; Y2 := OutPts[Length(OutPts) - 1].Y; //交点 GetIntersectXY(X1, Y1, X2, Y2, X3, Y3, X4, Y4, X, Y); //交点在(X1, Y1)-(X2, Y2)的反向延长线上? if Abs(GetLineLength(X2, Y2, X1, Y1) + GetLineLength(X1, Y1, X, Y) - GetLineLength(X2, Y2, X, Y)) < 0.0001 then begin //舍去线段(X1,Y1)-(X2,Y2) if Length(OutPts) > 2 then SetLength(OutPts, Length(OutPts) - 1) else begin SetLength(OutPts, 2); OutPts[0].X := X3; OutPts[0].Y := Y3; OutPts[1].X := X4; OutPts[1].Y := Y4; break; end; end //反向延长线 else begin //用交点取代最后点 OutPts[Length(OutPts) - 1].X := X; OutPts[Length(OutPts) - 1].Y := Y; //交点在(X3, Y3)-(X4, Y4)的正向延长线上? if Abs(GetLineLength(X3, Y3, X4, Y4) + GetLineLength(X4, Y4, X, Y) - GetLineLength(X3, Y3, X, Y)) < 0.0001 then //(X3,Y3)关于(X,Y)的对称点(X4,Y4) GetSymmetricXY(X3, Y3, X, Y, X4, Y4); SetLength(OutPts, Length(OutPts) + 1); OutPts[Length(OutPts) - 1].X := X4; OutPts[Length(OutPts) - 1].Y := Y4; break; end; end; end; //封闭区域特别处理 if (GetLineLength(InPts[0].X, InPts[0].Y, InPts[Length(InPts) - 1].X, InPts[Length(InPts) - 1].Y) < 0.0001) and (Length(OutPts) > 3) then while Length(OutPts) > 3 do begin i := 0; j := Length(OutPts) - 1; X1 := OutPts[i + 1].X; Y1 := OutPts[i + 1].Y; X2 := OutPts[i].X; Y2 := OutPts[i].Y; X3 := OutPts[j - 1].X; Y3 := OutPts[j - 1].Y; X4 := OutPts[j].X; Y4 := OutPts[j].Y; //交点 GetIntersectXY(X1, Y1, X2, Y2, X3, Y3, X4, Y4, X, Y); //交点在(X1, Y1)-(X2, Y2)的反向延长线上? if Abs(GetLineLength(X2, Y2, X1, Y1) + GetLineLength(X1, Y1, X, Y) - GetLineLength(X2, Y2, X, Y)) < 0.0001 then //舍去点(X2,Y2) begin for k := i + 1 to Length(OutPts) - 1 do begin OutPts[k - 1].X := OutPts[k].X; OutPts[k - 1].Y := OutPts[k].Y; end; SetLength(OutPts, Length(OutPts) - 1); end //交点在(XX3, YY3)-(XX4, YY4)的反向延长线上? else if Abs(GetLineLength(X4, Y4, X3, Y3) + GetLineLength(X3, Y3, X, Y) - GetLineLength(X4, Y4, X, Y)) < 0.0001 then //舍去点(XX4,YY4) SetLength(OutPts, Length(OutPts) - 1) else begin //用交点代替首尾节点 OutPts[i].X := X; OutPts[i].Y := Y; OutPts[j].X := X; OutPts[j].Y := Y; break; end; end; Result := (Length(OutPts) >= 2); end; end; //作两线段的中心线: 输入线段(X1,Y1)-(X2,Y2)、(X3,Y3)-(X4,Y4); 输出中心线(LX,LY)-(RX,RY); 若线段端点重合返回False function GetCentreline(X1, Y1, X2, Y2, X3, Y3, X4, Y4: Double; var LX, LY, RX, RY: Double): Boolean; var tX1, tY1, tX2, tY2: Double; d: Double; begin if (Abs(X2 - X1) < 0.0001) and (Abs(Y2 - Y1) < 0.0001) then Result := False else begin d := GetIntersectAngle(X1, Y1, X2, Y2, X3, Y3, X4, Y4); if d > 90 then begin tX1 := (X1 + X4) / 2; tY1 := (Y1 + Y4) / 2; tX2 := (X2 + X3) / 2; tY2 := (Y2 + Y3) / 2; end else begin tX1 := (X1 + X3) / 2; tY1 := (Y1 + Y3) / 2; tX2 := (X2 + X4) / 2; tY2 := (Y2 + Y4) / 2; end; LX := tX1; LY := tY1; RX := tX2; Ry := tY2; Result := True; end; end; //判断两直线有无交点: 输入线段(X1,Y1)-(X2,Y2)、(X3,Y3)-(X4,Y4); 若两线段有交点返回True function IsLineIntersect(X1, Y1, X2, Y2, X3, Y3, X4, Y4: Double): Boolean; var k1, k2: Double; X, Y: Double; begin if ((Abs(X2 - X1) < 0.0001) and (Abs(Y2 - Y1) < 0.0001) or (Abs(X4 - X3) < 0.0001) and (Abs(Y4 - Y3) < 0.0001)) then //有一线段端点重合 Result := False else if (X2 = X1) and (X4 = X3) then //平行 Result := False else begin if (X2 = X1) then begin k2 := (Y4 - Y3) / (X4 - X3); X := X1; Y := k2 * (X - X3) + Y3; end else if (X4 = X3) then begin k1 := (Y2 - Y1) / (X2 - X1); X := X3; Y := k1 * (X - X1) + Y1; end else begin k1 := (Y2 - Y1) / (X2 - X1); k2 := (Y4 - Y3) / (X4 - X3); if k1 = k2 then //平行 begin Result := False; exit; end else begin X := (Y4 - k2 * X4 - Y2 + k1 * X2) / (k1 - k2); Y := (k1 * (Y4 - k2 * X4) - k2 * (Y2 - k1 * X2)) / (k1 - k2); end; end; //交点是否在线段上 Result := (GetLineLength(X, Y, X1, Y1) + GetLineLength(X, Y, X2, Y2) - GetLineLength(X1, Y1, X2, Y2) < 0.0001) and (GetLineLength(X, Y, X3, Y3) + GetLineLength(X, Y, X4, Y4) - GetLineLength(X3, Y3, X4, Y4) < 0.0001); end; end; //两直线交点: 输入线段(X1,Y1)-(X2,Y2)、(X3,Y3)-(X4,Y4); 输出交点(X,Y); 若两线段平行返回False function GetIntersectXY(X1, Y1, X2, Y2, X3, Y3, X4, Y4: Double; var X, Y: Double): Boolean; var k1, k2: Double; begin if ((Abs(X2 - X1) < 0.0001) and (Abs(Y2 - Y1) < 0.0001) or (Abs(X4 - X3) < 0.0001) and (Abs(Y4 - Y3) < 0.0001)) then //有一线段端点重合 Result := False else if (X2 = X1) and (X4 = X3) then //平行 Result := False else if (X2 = X1) then begin k2 := (Y4 - Y3) / (X4 - X3); X := X1; Y := k2 * (X - X3) + Y3; Result := True; end else if (X4 = X3) then begin k1 := (Y2 - Y1) / (X2 - X1); X := X3; Y := k1 * (X - X1) + Y1; Result := True; end else begin k1 := (Y2 - Y1) / (X2 - X1); k2 := (Y4 - Y3) / (X4 - X3); if k1 = k2 then //平行 Result := False else begin X := (Y4 - k2 * X4 - Y2 + k1 * X2) / (k1 - k2); Y := (k1 * (Y4 - k2 * X4) - k2 * (Y2 - k1 * X2)) / (k1 - k2); Result := True; end; end; end; //作线段的参考线: 输入线段(X1,Y1)-(X2,Y2)、角度(-360~360); 输出与已知线段成已知角度的线段的另一端点(X,Y); 若线段端点重合返回False function GetAngleLine(X1, Y1, X2, Y2: Double; angle: Double; var X, Y: Double): Boolean; var d, angle1: Double; begin if (Abs(X2 - X1) < 0.0001) and (Abs(Y2 - Y1) < 0.0001) then //线段端点重合 Result := False else begin d := GetLineLength(X1, Y1, X2, Y2); angle1 := (GetLineAngle(X1, Y1, X2, Y2) + angle) * Pi / 180; X := X1 + d * Cos(angle1); Y := Y1 + d * Sin(angle1); Result := True; end; end; //点在直线内侧: 输入线段(X1,Y1)-(X2,Y2)、点(X3,Y3); 若点在线段内侧返回True,否则返回False function IsPointInsideLine(X1, Y1, X2, Y2, X3, Y3: Double): Boolean; var // a13, a23, a: Double; X0, Y0: Double; begin if (Abs(X2 - X1) < 0.0001) and (Abs(Y2 - Y1) < 0.0001) then //端点重合 if (Abs(X3 - X1) < 0.0001) and (Abs(Y3 - Y1) < 0.0001) then //重合 Result := True else Result := False else begin GetVertXY(X1, Y1, X2, Y2, X3, Y3, X0, Y0); Result := ((X0 >= Min(X1, X2)) and (X0 <= Max(X1, X2)) and (Y0 >= Min(Y1, Y2)) and (Y0 <= Max(Y1, Y2))); {a13 := GetIntersectAngle(X1,Y1,X2,Y2,X1,Y1,X3,Y3); a23 := GetIntersectAngle(X2,Y2,X1,Y1,X2,Y2,X3,Y3); if (a13<=90) and (a23<=90) then Result := True else Result := False;} end; end; //点在直线上: 输入线段(X1,Y1)-(X2,Y2)、点(X3,Y3); 若点在线段上返回True,否则返回False function IsPointOnLine(X1, Y1, X2, Y2, X3, Y3: Double): Boolean; var d13, d23, d: Double; begin d13 := GetLineLength(X1, Y1, X3, Y3); d23 := GetLineLength(X2, Y2, X3, Y3); d := GetLineLength(X1, Y1, X2, Y2); Result := (Abs(d13 + d23 - d) < 0.0001); end; //点在相交区域:输入线段(X1,Y1)-(X2,Y2)、(X3,Y3)-(X4,Y4)、点(X,Y); 输出点所在相交区域的端点(X0,Y0)、(LX,LY)、(RX,RY) //若线段相交返回True,否则返回False function GetIntersectRegion(X1, Y1, X2, Y2, X3, Y3, X4, Y4, X, Y: Double; var X0, Y0, LX, LY, RX, RY: Double): Boolean; begin //交点 if not GetIntersectXY(X1, Y1, X2, Y2, X3, Y3, X4, Y4, X0, Y0) then Result := False else begin //交点与端点重合 if GetLineLength(X0, Y0, X2, Y2) < 0.00001 then begin LX := X1; LY := Y1; end else if GetLineLength(X0, Y0, X1, Y1) < 0.00001 then begin LX := X2; LY := Y2; end //交点在延长线上 else if Abs(GetLineAngle(X0, Y0, X1, Y1) - GetLineAngle(X0, Y0, X2, Y2)) < 0.001 then if GetLineLength(X1, Y1, X0, Y0) > GetLineLength(X2, Y2, X0, Y0) then begin LX := X1; LY := Y1; end else begin LX := X2; LY := Y2; end //指示点在哪个相交区域 else if IsClockwise(X3, Y3, X4, Y4, X, Y) = IsClockwise(X3, Y3, X4, Y4, X1, Y1) then begin LX := X1; LY := Y1; end else begin LX := X2; LY := Y2; end; //交点与端点重合 if GetLineLength(X0, Y0, X4, Y4) < 0.00001 then begin RX := X3; RY := Y3; end else if GetLineLength(X0, Y0, X3, Y3) < 0.00001 then begin RX := X4; RY := Y4; end //交点在延长线上 else if Abs(GetLineAngle(X0, Y0, X3, Y3) - GetLineAngle(X0, Y0, X4, Y4)) < 0.001 then if GetLineLength(X3, Y3, X0, Y0) > GetLineLength(X4, Y4, X0, Y0) then begin RX := X3; RY := Y3; end else begin RX := X4; RY := Y4; end //指示点在哪个相交区域 else if IsClockwise(X1, Y1, X2, Y2, X, Y) = IsClockwise(X1, Y1, X2, Y2, X3, Y3) then begin RX := X3; RY := Y3; end else begin RX := X4; RY := Y4; end; Result := True; end; end; //梯形顶点:输入方向线段(X1,Y1)-(X2,Y2)、(X3,Y3)-(X4,Y4)、给定面积A; //输出梯形顶点(LX1,LY1)、(LX2,LY2)和(RX1,RY1)、(RX2,RY2), 若梯形存在返回True,否则返回False function GetTrapezoidNodes(X1, Y1, X2, Y2, X3, Y3, X4, Y4, A: Double; var LX1, LY1, RX1, RY1, LX2, LY2, RX2, RY2: Double): Boolean; var angle1, angle2: Double; h, d, v: Double; Clockwise: Boolean; X, Y: Double; begin A := Abs(A); if (Abs(X4 - X2) < 0.0001) and (Abs(Y4 - Y2) < 0.0001) then //端点重合 begin Result := False; exit; end; //方向角 angle1 := GetIntersectAngle(X1, Y1, X2, Y2, X2, Y2, X4, Y4); angle2 := GetIntersectAngle(X3, Y3, X4, Y4, X4, Y4, X2, Y2); //底边长 d := GetLineLength(X2, Y2, X4, Y4); if (angle1 = 0) or (angle2 = 0) then Result := False else if (angle1 = 90) and (angle2 = 90) then begin h := A / d; //底边端点处垂线上点 GetVertDistXY(X2, Y2, X4, Y4, h, LX2, LY2, RX2, RY2); GetVertDistXY(X4, Y4, X2, Y2, h, RX1, RY1, LX1, LY1); Result := True; end else begin if (angle2 = 90) then v := 1 / Tan(angle1 * Pi / 180) else if (angle1 = 90) then v := 1 / Tan(angle2 * Pi / 180) else v := 1 / Tan(angle1 * Pi / 180) + 1 / Tan(angle2 * Pi / 180); //相邻线段交点 if GetIntersectXY(X1, Y1, X2, Y2, X3, Y3, X4, Y4, X, Y) then //底线与交点形成角的方向:顺时针? Clockwise := IsClockwise(X2, Y2, X4, Y4, X, Y) else Clockwise := True; //方案一:vh*h-2dh+2a=0求解 if d * d - 2 * v * A < 0 then begin LX1 := X2; LY1 := Y2; RX1 := X4; RY1 := Y4; end else begin //梯形高度 h := (d - Sqrt(d * d - 2 * v * A)) / v; //平行线 GetParaLineByDist(X2, Y2, X4, Y4, h, not Clockwise, LX1, LY1, RX1, RY1); //平行线与相邻线段的交点 GetIntersectXY(X1, Y1, X2, Y2, LX1, LY1, RX1, RY1, LX1, LY1); GetIntersectXY(X3, Y3, X4, Y4, LX1, LY1, RX1, RY1, RX1, RY1); //梯形是否有效? if Abs((d + GetLineLength(LX1, LY1, RX1, RY1)) * h / 2 - A) > 0.1 then begin //平行线 GetParaLineByDist(X2, Y2, X4, Y4, h, Clockwise, LX1, LY1, RX1, RY1); //平行线与相邻线段的交点 GetIntersectXY(X1, Y1, X2, Y2, LX1, LY1, RX1, RY1, LX1, LY1); GetIntersectXY(X3, Y3, X4, Y4, LX1, LY1, RX1, RY1, RX1, RY1); end; end; //方案二:vh*h+2dh-2a=0求解 if d * d + 2 * v * A < 0 then begin LX2 := X2; LY2 := Y2; RX2 := X4; RY2 := Y4; end else begin //梯形高度 h := (-d + Sqrt(d * d + 2 * v * A)) / v; //平行线 GetParaLineByDist(X2, Y2, X4, Y4, h, Clockwise, LX2, LY2, RX2, RY2); //平行线与相邻线段的交点 GetIntersectXY(X1, Y1, X2, Y2, LX2, LY2, RX2, RY2, LX2, LY2); GetIntersectXY(X3, Y3, X4, Y4, LX2, LY2, RX2, RY2, RX2, RY2); //梯形是否有效? if Abs((d + GetLineLength(LX2, LY2, RX2, RY2)) * h / 2 - A) > 0.1 then begin //平行线 GetParaLineByDist(X2, Y2, X4, Y4, h, not Clockwise, LX2, LY2, RX2, RY2); //平行线与相邻线段的交点 GetIntersectXY(X1, Y1, X2, Y2, LX2, LY2, RX2, RY2, LX2, LY2); GetIntersectXY(X3, Y3, X4, Y4, LX2, LY2, RX2, RY2, RX2, RY2); end; end; Result := True; end; end; //三角形重心(垂直平分线交点): 输入点(X1,Y1)、(X2,Y2)、(X3,Y3), 若不在一直线上输出重心(X,Y),返回True,否则返回False function GetWeightCenter(X1, Y1, X2, Y2, X3, Y3: Double; var X, Y: Double): Boolean; begin if GetVertDist(X1, Y1, X3, Y3, X2, Y2) < 0.0001 then //三点在一直线 Result := False else begin X := ((Y2 - Y1) * (Y3 - Y2) * (Y1 - Y3) - (Y2 - Y1) * (X3 * X3 - X1 * X1) + (Y3 - Y1) * (X2 * X2 - X1 * X1)) / 2 / ((Y3 - Y1) * (X2 - X1) - (X3 - X1) * (Y2 - Y1)); Y := ((X2 - X1) * (X3 - X2) * (X1 - X3) - (X2 - X1) * (Y3 * Y3 - Y1 * Y1) + (X3 - X1) * (Y2 * Y2 - Y1 * Y1)) / 2 / ((X3 - X1) * (Y2 - Y1) - (Y3 - Y1) * (X2 - X1)); Result := True; end; end; //过三点作弧1: 输入三点(X1,Y1)、(X2,Y2)、(X3,Y3), //输出(X1,Y1)-(X3,Y3)之中点到以(X1,Y1)、(X3,Y3)为切点的圆弧切线交点的距离Dist以及夹角常数Angle(90°/270°) //若三点共线无法形成圆弧返回False, 否则返回True function GetArcBy3PointsMapX(X1, Y1, X2, Y2, X3, Y3: Double; var Angle, Dist: Double): Boolean; var X0, Y0: Double; //重心 XX, YY: Double; //(X1,Y1)-(X3,Y3)之中点 begin if GetWeightCenter(X1, Y1, X3, Y3, X2, Y2, X0, Y0) then begin if IsClockwise(X1, Y1, X3, Y3, X2, Y2) then Angle := 270 else Angle := 90; XX := (X1 + X3) / 2; YY := (Y1 + Y3) / 2; Dist := GetLineLength(X0, Y0, XX, YY); if Dist = 0 then Dist := 1.3946 else Dist := GetLineLength(X1, Y1, XX, YY) / Dist / 2 * 1.3946; // Dist := (GetLineLength(X0, Y0, X2, Y2)-GetLineLength(X0, Y0, XX, YY))/GetLineLength(X1, Y1, X3, Y3); Result := True; end else Result := False end; //过三点作弧2(折线成弧): 输入三点(X1,Y1)、(X2,Y2)、(X3,Y3), //输出圆心(X0,Y0)及圆心角Angle(-360~360);若三点共线无法形成圆弧返回False, 否则返回True function GetArcBy3PointsEx(X1, Y1, X2, Y2, X3, Y3: Double; var X0, Y0, Angle: Double): Boolean; var Clockwise0, Clockwise: Boolean; begin //有重心 if GetWeightCenter(X1, Y1, X2, Y2, X3, Y3, X0, Y0) then begin //<180的圆心角 Angle := GetIntersectAngle(X1, Y1, X0, Y0, X3, Y3, X0, Y0); //圆心角顺时针? Clockwise0 := IsClockwise(X1, Y1, X0, Y0, X3, Y3); //顶角顺时针? Clockwise := IsClockwise(X1, Y1, X2, Y2, X3, Y3); //>180的弧 if (Clockwise0 = Clockwise) then Angle := 360 - Angle; //递减 if ((Angle < 180) and Clockwise0) or ((Angle >= 180) and not Clockwise0) then Angle := -Angle; Result := True; end else Result := False; end; //指定起止点及圆心作弧: 输入起止点(X1,Y1)、(X2,Y2)、参考点(X3,Y3)、圆心(X0,Y0), //输出圆心角Angle(-360~360);若无法形成圆弧返回False, 否则返回True function GetArcByCenter(X1, Y1, X2, Y2, X3, Y3, X0, Y0: Double; var Angle: Double): Boolean; var Clockwise0, Clockwise: Boolean; begin if (GetLineLength(X0, Y0, X1, Y1) > 0.00001) and (GetLineLength(X0, Y0, X2, Y2) > 0.00001) and (GetLineLength(X1, Y1, X2, Y2) > 0.00001) and (GetLineLength(X2, Y2, X3, Y3) > 0.00001) and (GetLineLength(X1, Y1, X3, Y3) > 0.00001) then begin //弧度 Angle := GetLineAngle(X0, Y0, X2, Y2) - GetLineAngle(X0, Y0, X1, Y1); //圆心角顺时针? Clockwise0 := IsClockwise(X1, Y1, X0, Y0, X2, Y2); //参考点决定弧度 Clockwise := IsClockwise(X1, Y1, X3, Y3, X2, Y2); //圆心与参考点不在起止点连线的同一侧时取小弧;反之,取大弧 if ((Clockwise0 = Clockwise) = (Abs(Angle) <= 180)) then if Angle > 0 then Angle := Angle - 360 else Angle := 360 + Angle; Result := True; end else Result := False; end; //指定起止点及半径作弧: 输入起止点(X1,Y1)、(X2,Y2)、参考点(X3,Y3)、半径Radius, //输出圆心(X0,Y0)及圆心角Angle(-360~360);若无法形成圆弧返回False, 否则返回True function GetArcByRadius(X1, Y1, X2, Y2, X3, Y3, Radius: Double; var X0, Y0, Angle: Double): Boolean; var X, Y, XX0, YY0: Double; d, Angle0: Double; Clockwise0, Clockwise: Boolean; SmallArc: Boolean; begin if (Radius > 0) and (GetLineLength(X1, Y1, X2, Y2) > 0.00001) and (GetLineLength(X2, Y2, X3, Y3) > 0.00001) and (GetLineLength(X1, Y1, X3, Y3) > 0.00001) then begin //取中点 X := (X1 + X2) / 2; Y := (Y1 + Y2) / 2; //中点到圆心距离 if Radius - GetLineLength(X1, Y1, X, Y) > 0 then begin d := Sqrt(Radius * Radius - Sqr(GetLineLength(X1, Y1, X, Y))); //圆心 GetVertDistXY(X1, Y1, X, Y, d, X0, Y0, XX0, YY0); //弧度 Angle := GetLineAngle(X0, Y0, X2, Y2) - GetLineAngle(X0, Y0, X1, Y1); Angle0 := GetLineAngle(XX0, YY0, X2, Y2) - GetLineAngle(XX0, YY0, X1, Y1); //圆心角顺时针? Clockwise0 := IsClockwise(X1, Y1, X0, Y0, X2, Y2); //参考点决定圆心与弧度 Clockwise := IsClockwise(X1, Y1, X3, Y3, X2, Y2); //参考点在起止点连线内侧且垂距小于Radius-d时取小弧 SmallArc := IsPointInsideLine(X1, Y1, X2, Y2, x3, Y3) and (GetVertDist(X1, Y1, X2, Y2, X3, Y3) < Radius - d); //取小弧时,圆心与参考点不在同一侧;反之,圆心与参考点在同一侧 if (SmallArc = (Clockwise0 = Clockwise)) then begin X0 := XX0; Y0 := YY0; Angle := Angle0; end; //真实弧度 if SmallArc = (Abs(Angle) > 180) then if Angle > 0 then Angle := Angle - 360 else Angle := 360 + Angle; Result := True; end else Result := False; end else Result := False; end; //夹角过渡弧1: 输入两线段(X1,Y1)-(X2,Y2)、(X3,Y3)-(X4,Y4)与圆弧半径r(若线段有交点,默认保留较长的端点), //输出延长/截断的两线段(LX1,LY1)-(LX2,LY2)、(RX1,RY1)-(RX2,RY2)与圆心(X0,Y0) //若线段无夹角或半径不合适返回False; 否则返回True function GetInterimArc(X1, Y1, X2, Y2, X3, Y3, X4, Y4, r: Double; var LX1, LY1, LX2, LY2, RX1, RY1, RX2, RY2, X0, Y0: Double): Boolean; var X, Y: Double; //交点 Angle: Double; //夹角/2 h: Double; //边线上切点到交点距离 tmpX, tmpY: Double; begin if (r <= 0) or not GetIntersectXY(X1, Y1, X2, Y2, X3, Y3, X4, Y4, X, Y) then //平行 Result := False else begin if GetLineLength(X1, Y1, X, Y) > GetLineLength(X2, Y2, X, Y) then //保留点 begin LX1 := X1; LY1 := Y1; end else begin LX1 := X2; LY1 := Y2; end; if GetLineLength(X3, Y3, X, Y) > GetLineLength(X4, Y4, X, Y) then begin RX1 := X3; RY1 := Y3; end else begin RX1 := X4; RY1 := Y4; end; Angle := GetIntersectAngle(LX1, LY1, X, Y, RX1, RY1, X, Y) / 2 / 180 * Pi; //夹角 h := r / Tan(Angle); //边线上切点到交点距离 GetExtendDistXY(LX1, LY1, X, Y, h, tmpX, tmpY, LX2, LY2); //(LX2,LY2)延长线上点(切点) GetExtendDistXY(RX1, RY1, X, Y, h, tmpX, tmpY, RX2, RY2); //(RX2,RY2) GetVertDistXY(X, Y, LX2, LY2, r, tmpX, tmpY, X0, Y0); //(X0,Y0)圆弧中心点 if Abs(GetLineLength(tmpX, tmpY, RX2, RY2) - r) < 0.0001 then begin X0 := tmpX; Y0 := tmpY; end; Result := True; end; end; //夹角过渡弧2: 输入两线段(X1,Y1)-(X2,Y2)、(X3,Y3)-(X4,Y4)、保留区域标识点(FX,FY)与圆弧半径r, //输出延长/截断的两线段(LX1,LY1)-(LX2,LY2)、(RX1,RY1)-(RX2,RY2)与圆心(X0,Y0) //若线段无夹角或半径不合适返回False; 否则返回True function GetInterimArcEx(X1, Y1, X2, Y2, X3, Y3, X4, Y4, FX, FY, r: Double; var LX1, LY1, LX2, LY2, RX1, RY1, RX2, RY2, X0, Y0: Double): Boolean; var X, Y: Double; //交点 Angle: Double; //夹角/2 h: Double; //边线上切点到交点距离 tmpX, tmpY: Double; begin if (r <= 0) or not GetIntersectRegion(X1, Y1, X2, Y2, X3, Y3, X4, Y4, FX, FY, X, Y, LX1, LY1, RX1, RY1) then //平行 Result := False else begin Angle := GetIntersectAngle(LX1, LY1, X, Y, RX1, RY1, X, Y) / 2 / 180 * Pi; //夹角 h := r / Tan(Angle); //边线上切点到交点距离 GetExtendDistXY(LX1, LY1, X, Y, h, tmpX, tmpY, LX2, LY2); //(LX2,LY2)延长线上点(切点) GetExtendDistXY(RX1, RY1, X, Y, h, tmpX, tmpY, RX2, RY2); //(RX2,RY2) GetVertDistXY(X, Y, LX2, LY2, r, tmpX, tmpY, X0, Y0); //(X0,Y0)圆弧中心点 if Abs(GetLineLength(tmpX, tmpY, RX2, RY2) - r) < 0.0001 then begin X0 := tmpX; Y0 := tmpY; end; Result := True; end; end; //夹角弧3: 输入两线段(X1,Y1)-(X2,Y2)、(X3,Y3)-(X4,Y4)与圆弧半径r, //输出延长/截断的两线段(LX1,LY1)-(LX2,LY2)、(RX1,RY1)-(RX2,RY2); //(LX2,LY2)-(RX2,RY2)之中点到以(LX2,LY2)、(RX2,RY2)为切点的圆弧切线交点的距离Dist以及夹角常数Angle(90°/270°) //若线段无夹角或半径不合适返回False; 否则返回True function GetInterimArcMapX(X1, Y1, X2, Y2, X3, Y3, X4, Y4, r: Double; var LX1, LY1, LX2, LY2, RX1, RY1, RX2, RY2, Angle, Dist: Double): Boolean; var X0, Y0: Double; //圆弧中心 X, Y: Double; //直线交点 XX, YY: Double; //(LX2,LY2)-(RX2,RY2)之中点 begin if GetInterimArc(X1, Y1, X2, Y2, X3, Y3, X4, Y4, r, LX1, LY1, LX2, LY2, RX1, RY1, RX2, RY2, X0, Y0) then begin GetIntersectXY(X1, Y1, X2, Y2, X3, Y3, X4, Y4, X, Y); if IsClockwise(LX2, LY2, RX2, RY2, X, Y) then Angle := 270 else Angle := 90; XX := (LX2 + RX2) / 2; YY := (LY2 + RY2) / 2; Dist := r - GetLineLength(X0, Y0, XX, YY); Result := True; end else Result := False end; end.