graphmath.pas

这是图形处理中常用的数学计算方法。比较全面

function DisPointLine(const x, y, x1, y1, x2, y2: Double; var VF: Boolean): Double; OverLoad; // VF=true 返回值等于点到直线的距离
function DisPointLine(const x, y: Double; L: TLineRecord; var VF: Boolean): Double; OverLoad; //VF=true 返回值等于点到直线的距离
{点到圆的距离}
function DisPointCircle(const x, y, oX, oY, R: Double): Double;

{计算两条平行直线的距离}
function DisLineLine(line1, line2: TBeeLine): Double; OverLoad;
function DisLineLine(const L, b1, b2: Double): Double; OverLoad; // L:直线斜角，b1,b2:斜距
function DisLineLine(const L1, L2: TLineRecord; var R: Double): Boolean; OverLoad; //两平行直线L1,L2的距离 Result=false L1,L2 不平行
function DisLineLine(dot1, dot2, dot3, dot4: TRealPoint): Double; OverLoad;

{两平行(同心)弧线的相对距离}
function DisArcArc(po, p1, p2: TRealPoint): Double;

{两平行直线的相交(重叠)长度}
function TwoLineRepeatLen(l1, l2: TSecLine): Double;

//===============================计算面积==========================================================>

{根据三点求三角形面积}
function GetTriangleArea(x1, y1, x2, y2, x3, y3: Double): Double; overload;
function GetTriangleArea(p1, p2, p3: TRealPoint): Double; overload;
function GetTriangleArea(a, b, c: Double): Double; overload; //根据三边长(a,b,c)计算面积

{扇形的面积}
function GetFanArea(pArc: pPolygonArc): Double; overload;
function GetFanArea(fan: TCircleArc): Double; overload;

{弓形的面积}
function GetBowArea(pEdge: pPolygonEdge): Double; overload;
function GetBowArea(bow: TCircleArc): Double; overload;

{求多边形的面积}
function GetPolygonArea(pPolygon: pPolygonRecord): Double;

//================================计算角度=========================================================>

{ 计算活动点相对基准点的矢量角[0..2*pi)，RetBevel为True则为倾斜角[0, pi);
  注: -1两点重合,基点在前,动点在后。相对于X轴正向的角度}
function LineAngle(const basx, basy, ax, ay: Double; RetBevel: Boolean = False): TRadian; overload;
function LineAngle(const basPnt, aPnt: TRealPoint; RetBevel: Boolean = False): TRadian; overload;
function LineAngle(const pPolyEdge: pPolygonEdge; RetBevel: Boolean = False): TRadian; overload;
function LineAngle(const Line: TSecLine; RetBevel: Boolean = False): TRadian; overload;
function LineAngle(const L: TLineRecord; RetBevel: Boolean = False): TRadian; overload;

{计算活动边相对于基准边的角度(两线跨越的角度),[0..2*pi)}
function TwoLineSpanAngle(basPnt1, basPnt2, aPnt1, aPnt2: TRealPoint): TRadian; overload;
function TwoLineSpanAngle(basLine, aLine: TSecLine): TRadian; overload; // 基准边: L1

{计算两条直线的相对倾斜角, [0..pi)}
function LineLineBevel(const Ang1, Ang2: TRadian): TRadian; OverLoad; {Ang1, Ang2:两条直线的倾斜角}

{两弧线的相交角度(前提：两弧线肯定有相交部分)}
function TwoArcCutAngle(Ang1S, Ang1E, Ang2S, Ang2E: TRadian): TRadian; //?

{通过三边得到三角形角度 AdjLen1, AdjLen2为邻边长, FaceLen为对边长}
function TriangleAngle(AdjLen1, AdjLen2, FaceLen: Double): TRadian;

{求弧的圆心角}
function ArcCenterAngle(pArc: pPolygonArc): TRadian;

//==================================变换与转换=====================================================>

{沿线段移动一段距离d,分别求出dx,dy的偏移距离}
function GetMoveDxDy(SPnt, EPnt: TRealPoint; D: Double): TRealPoint;

{在线上某点处，沿线的走向移动d, 得到移动后的坐标}
function GetMovedPoint(MovePnt, SPnt, EPnt: TRealPoint; D: Double): TRealPoint;

{米和毫米相互转换}
function GetMillimetre(Metre: Double): Double;
function GetMetre(MilliMetre: Double): Double;

{平方米和平方毫米相互转换}
function GetSquareMillimetre(SquqreMetre: Double): Double;
function GetSquqreMetre(SquareMilliMetre: Double): Double;

{立方米和立方毫米相互转换}
function GetCubeMillimetre(CubeMetre: Double): Double;
function GetCubeMetre(CubeMilliMetre: Double): Double;

{以bd点的旋转,L旋转角度}
function RotatePoint(SpinPnt, BasePnt: TPoint; Angle: TRadian): TPoint; OverLoad;
function RotatePoint(SpinPnt, BasePnt: TRealPoint; Angle: TRadian): TRealPoint; OverLoad;
function SpinPoint(var SpinPnt: TRealPoint; BasePnt: TRealPoint; Angle: TRadian): TRealPoint;

{旋转弧、直线、多边形}
procedure SpinSectline(var lineS: TSecLine; x0, y0: Double; e: TRadian);
procedure SpinPolygon(var pPoly: pPolygonRecord; BasX, BasY: Double; Angle: TRadian);
procedure SpinArc(var arc: TCircleArc; x0, y0: Double; e: TRadian);

{镜像弧、直线、多边形; A,B,C为直线方程的系数，Ax+By+C=0;}
procedure MirrorArc(var arc: TCircleArc; A, B, C: Double);
procedure MirrorSectline(var lineS: TSecLine; A, B, C: Double);

{镜像多边形}
function GetMirrorPolygon(pHeadEdge: pPolygonEdge; A, B, C: Double): pPolygonEdge; overload;
function GetMirrorPolygon(pHeadEdge: pPolygonEdge; Point1, Point2: TRealPoint): pPolygonEdge; overload;
function GetMirrorPolygon(pPoly: pPolygonRecord; Point1, Point2: TRealPoint): pPolygonRecord; overload;

{线段平移; d垂直位移; if dx>=0 then d>0 else d<0}
function ParallelLine(lineS: TSecLine; d: Double): TSecLine; overload;
function ParallelLine(lineB: TBeeLine; d: Double): TBeeLine; overload;
function ParallelLine(LineS: TSecline; Distance: Double; DirX, DirY: Boolean): TSecLine; overload;

{缩短线段(x1,y1,x2,y2), 移动(x2,y2)}
procedure ShortenLineSect(var x1, y1, x2, y2: Double; const w: Double);

{延长线段(x1,y1,x2,y2), 移动(x2,y2)}
procedure ExtendLineSect(x1, y1: Double; var x2, y2: Double; const DeltaLen: Double); overLoad;
procedure ExtendLineSect(var L: TSecLine; const DeltaLen: Double; StartToEnd: Boolean = True); overload;

{延长线段L,if fw=true 向(x2,y2)方向延长，反之}
procedure ExtendLineSect(var AP1, AP2: TRealPoint; AP1ExtV, AP2ExtV: Double); overload;

{把线段(x1,y1,x2,y2)延长到，点(x,y)在直线(x1,y1,x2,y2)的投影}
procedure ExtLineToPrjPoint(var x1, y1, x2, y2: Double; const x, y: Double);

{扩大弧}
procedure ExtendArc(var c: TCircleArc; n: Double); overload; //将弧的两端各延伸n

{ 合并线段L1,L2存到L1,若条件不够返回false}
function CoalitionLine(var L1, L2: TLineRecord): Boolean;

{坐标系的平移，以(x0,y0)为新的坐标原点(原过程名CoordinateParallel)}
function ShiftCoord(P: TRealPoint; x0, y0: Double): TRealPoint; //未用

{将角度转换成弧度. Angle:为角度值，Result=弧度}
function MyDegToRad(Degrees: Double): Double;
{将弧度转换成角度. Arc : 为弧度值,Result=角度}
function MyRadToDeg(Radians: Double): Double;

{直线的角度转化为倾斜角, 即转换[0..2*pi)为[0..pi)}
function AngleToBevel(const Angle: TRadian): TRadian;

{
数学坐标系的角度(st,et)转换成屏幕坐标系的弧度(st,et);
 起始角:st,终止角:et,为逆时针排列}
procedure DegreeToRadian(var st, et: Double);
{屏幕坐标系的弧度(st,et)转换成数学坐标系的角度(st,et)}
procedure RadianToDegree(var st, et: Double);

{直线的角度(clockwise=true时为顺时针方向)转弧度(顺时针方向)
 0<=直线的角度<180  0<=返回<pi  既数学角度-->屏幕角度}
function X_LineAngToAnd(const L: Double; clockwise: Boolean): Double;

function StrToPos(AStr: string): TMyPosition;
function PosToStr(APos: TMyPosition): string;

{将圆心角度定义弧转换成圆心两点定义弧}
function CircleToPointArc(Arc: TCircleArc): TPointArc; overload;
function CircleToPointArc(cx, cy: Double; ts, te: Double; r: Double): TPointArc; overload;


{图形复制}
function CopyPolygon(pPoly: pPolygonRecord): pPolygonRecord; overload;
function CopyPolygon(pHeadEdge: pPolygonEdge): pPolygonEdge; overload;
function CopyLine(pLine: pLineRecord): pLineRecord; //a:
function CopyArc(pArc: pArcRecord): pArcRecord; overload;
function CopyArc(pArc: pPolygonArc): pPolygonArc; overload;
function CopyCircle(pCircle: pCircleRecord): pCircleRecord;
function CopyRectangle(pRect: pRectRecord): pRectRecord;
function CopyText(pText: pTextRecord): pTextRecord;
function CopyObject(p: pObjRec): pObjRec;

{流操作}
function BoolFromStream(Stream: TStream): Boolean;
function ByteFromStream(Stream: TStream): Byte;
function FloatFromStream(Stream: TStream): Extended;
function PointFromStream(Stream: TStream): TPoint;
function SizeFromStream(Stream: TStream): TSize;
function RectFromStream(Stream: TStream): TRect;
function IntFromStream(Stream: TStream): integer;
procedure StreamFromStream(Source, SubStream: TStream);
function StringFromStream(Stream: TStream): string;

procedure BoolToStream(Stream: TStream; Value: Boolean);
procedure ByteToStream(Stream: TStream; Value: Byte);
procedure IntToStream(Stream: TStream; Value: Integer);
procedure LongIntToStream(Stream: TStream; Value: LongInt);
procedure FloatToStream(Stream: TStream; Value: Extended);
procedure SizeToStream(Stream: TStream; Value: TSize);
procedure RectToStream(Stream: TStream; Value: TRect);
procedure ColorToStream(Stream: TStream; Value: COLORREF);
procedure PointToStream(Stream: TStream; Value: TPoint);
procedure StringToStream(Stream: TStream; Value: string);
procedure StreamToStream(Stream, SubStream: TStream);

function GetCosineAgl(a, b, c: Double): Double;
function MultPolygonArea(lsTop: TList; xM, yM: Double): Double;

{将字符串str包含的所有空格都压缩掉}
function TrimAll(Str: string): string;

procedure FreeList(ls: TList; bFree: Boolean = true); //释放List所占内存空间
function DelStringInList(var strs: TStringList; s: string; b: Boolean): Boolean; //过滤stringlist中是否包含s
procedure SwapCoord(var P1, p2: TRealPoint); //交换两个坐标值



implementation

//基本方法

function GetMirrorParam(A, B, C, Angle: Double): TArr33;
const
  ConArr: TArr33 = ((1, 0, 0), (0, 1, 0), (0, 0, 1));
var
  T0, T1, T2, T3, T4, T5: TArr33;
begin
  if RE(A, 0) then
    A := ERROR7;

  T1 := ConArr;
  T1[2][3] := C / A;

  T2 := ConArr;
  T2[1][1] := MyCos(-Angle);
  T2[1][2] := MySin(-Angle);
  T2[2][1] := -MySin(-Angle);
  T2[2][2] := MyCos(-Angle);

  T3 := ConArr;
  T3[2][2] := -1.0;

  T4 := ConArr;
  T4[1][1] := MyCos(Angle);
  T4[1][2] := MySin(Angle);
  T4[2][1] := -MySin(Angle);
  T4[2][2] := MyCos(Angle);

  T5 := ConArr;
  T5[3][1] := -C / A;

  T0 := MatrixMultiply(T1, T2);
  T0 := MatrixMultiply(T0, T3);
  T0 := MatrixMultiply(T0, T4);
  T0 := MatrixMultiply(T0, T5);
  Result := T0;
end;

function SubArcBoxRect(const sAngle, eAngle: TRadian; r1, r2: Double; Ox, Oy: Double): TRectangle;
var
  x1, x2, x3, x4, y1, y2, y3, y4: Double;
  maxx, maxy, minx, miny: Double;
begin
  x1 := Ox + cos(sAngle) * r1;
  y1 := Oy + sin(sAngle) * r1;
  x2 := Ox + cos(eAngle) * r1;
  y2 := Oy + sin(eAngle) * r1;
  x3 := Ox + cos(sAngle) * r2;
  y3 := Oy + sin(sAngle) * r2;
  x4 := Ox + cos(eAngle) * r2;
  y4 := Oy + sin(eAngle) * r2;
  if RG(x1, x2) then
  begin
    Maxx := x1;
    Minx := x2;
  end
  else
  begin
    Maxx := x2;
    Minx := x1;
  end;
  if RL(Maxx, x3) then
    Maxx := x3
  else if RG(Minx, x3) then
    Minx := x3;
  if RL(Maxx, x4) then
    Maxx := x4
  else if RG(Minx, x4) then
    Minx := x4;
  if RG(y1, y2) then
  begin
    Maxy := y1;
    Miny := y2;
  end
  else
  begin
    Maxy := y2;
    Miny := y1;
  end;
  if RL(Maxy, y3) then
    Maxy := y3
  else if RG(Miny, y3) then
    Miny := y3;
  if RL(Maxy, y4) then
    Maxy := y4
  else if RG(Miny, y4) then
    Miny := y4;

  Result.Left := Minx;
  Result.Right := Maxx;
  Result.Top := Maxy;
  Result.Bottom := Miny;
end;

{判断多边形内的弧与线段是否相交}

function IfArcAndSecCross(pArc: pPolygonArc; ASect: TSecLine): Boolean;
var
  Dis: Double;
  dPntJD: TCrossPoint;
begin
  Result := false;
  Dis := DisPointLine(pArc.OPnt, ASect);
  if Dis < pArc.R then
  begin
    dPntJD := LineArcJD(ASect.P1, ASect.P2, pArc);
    if dPntJD.PointNum >= 1 then
    begin
      if PointOnArc(dPntJD.P1, pArc) then
        Result := true;
      if dPntJD.PointNum = 2 then
      begin
        if PointOnArc(dPntJD.P2, pArc) then
          Result := true;
      end;
    end;
  end;
end;




//===========================基本运算===========================>>

procedure Add(var x: Integer; n: Integer);
begin
  x := x + n;
end;

procedure Add(var x: Double; n: Double);
begin
  x := x + n;
end;

procedure Add(var s1: string; s2: string);
begin
  s1 := s1 + s2;
end;

procedure Sub(var x: Integer; n: Integer);
begin
  x := x - n;
end;

procedure Sub(var x: Double; n: Double);
begin
  x := x - n;
end;

procedure Sub(var s1: string; s2: string);
var
  P: PChar;
  I: Integer;
begin
  P := StrPos(PChar(s1), PChar(s2));
  if P <> nil then
  begin
    I := Length(s1) - Length(P);
    Delete(s1, I, Length(s2));
  end;
end;

{矢量减}

function VectorMinus(const dPnt1, dPnt2: TRealPoint): TRealPoint;
begin
  Result.x := dPnt2.x - dPnt1.x;
  Result.y := dPnt2.y - dPnt1.y;
end;