Schnittpunkt zweier Strecken ermitteln

[LoCrux]

Da ich gerade mal wieder hier am stöbern bin...

..diese (folgende) Lösung hatte ich mal vor Ewigkeiten zusammengebastelt. Fragt mich bitte nichtmehr zwecks Dokumentation.
Die Lösung funktioniert trozdem....

Delphi-Quellcode:

interface {Part}

//==[ CONSTANTS ]========//

const
  YES         = TRUE;
  NO          = FALSE;
  cPi         = 3.1415926535897932384626433832795028841971693993751058209749445923078164062862089986280348253421170679;
  c2Pi        = 2*cPi;
  cPi90       = cPi/2;
  cPi270      = cPi+cPi90;
  cDegToRad   = (cPi/180);
  cRadToDeg   = (180/cPi);

//==[ TYPE-DEFS ]========//

type

  TSimplePoint = packed record
                   x,y : Double;
                 end;

  TLineLinear   = packed record
                    p1,p2 : TSimplePoint;  // The Building Points;
                    A,B,C : Double;        // 0 = A*x + B*y + C
                  end;

  TLinesBehave  = (lbSame, lbIntersect, lbOrthogonal, lbParallel,
                   lbline1ParaX, lbline1ParaY, lbline2ParaX, lbline2ParaY);

  TLinesBehaves = set of TLinesBehave;

implementation {Part}

//==[ LINE OPERATIONS ]==//

function IsSame(val1,val2:Extended):Boolean; 
begin
  result := IsZero(val1-val2);
end;

function GetMin(values:array of Double;IncZero:Boolean):Double;
var
  s,cnt   : INTEGER;
  AllZero : BOOLEAN;
begin
  s := LOW(values);
  AllZero := NO;
  if IncZero
  then begin
    result := values[s];
    INC(s);
  end
  else begin
    repeat
      AllZero := (s>High(Values));
      if not(AllZero)
      then begin
        result  := values[s];
        INC(s);
      end;
    until Not(IsZero(result)) or AllZero;
  end;
  if not(AllZero)
  then begin
    for cnt := LOW(values)+s to HIGH(values)
    do if (result>values[cnt]) and (IncZero and IsZero(values[cnt]))
       then result:=values[cnt];
  end
  else result := 0;
end;

function Det2x2(p1,p2:TSimplePoint):Double;
begin
  result := (p1.x*p2.y)-(p1.y*p2.x);
end;

function BuildLineLinFromPoints(p1,p2:TSimplePoint):TLineLinear;
var
  min   : Double;
begin
  result.p1 := p1;
  result.p2 := p2;
  result.A  := p1.y-p2.y;
  result.B  := p2.x-p1.x;
  result.C  := DET2x2(p1,p2);
  min := GetMin([ABS(result.A),ABS(result.B),ABS(result.C)],no);
  if not(IsZero(min))
  then begin
    result.A := result.A/min;
    result.B := result.B/min;
    result.C := result.C/min;
  end;
end;

function  CheckLineLinBehaviour(ll1,ll2:TLineLinear;var Alpha:Double):TLinesBehaves;
var
  NotReady  : Boolean;
  m1,m2     : Double;

  function DoAlphaLin:Double;
  var
    Divident,
    Divisor   : Double;
  begin
    Divisor  := (ll1.A*ll2.A)-(ll1.B*ll2.B);
    Divident := (ll1.A*ll2.B)-(ll1.B*ll2.A);
    if not(IsZero(Divisor))
    then result := arctan(Divident/Divisor)
    else result := 0;
  end;

  function DoAlphaNor:Double;
  var
    Divident,
    Divisor   : Double;
  begin
    m1       := ll1.A/(-ll1.B);
    m2       := ll2.A/(-ll2.B);
    Divisor  := m2-m1;
    Divident := 1+(m1*m2);
    if not(IsZero(Divisor))
    then result := arctan(Divident/Divisor)
    else result := 0;
  end;

begin
  result := [];
  if IsZero(ll1.A) then result := result+[lbLine1ParaX];
  if IsZero(ll2.A) then result := result+[lbLine2ParaX];
  if IsZero(ll1.B) then result := result+[lbLine1ParaY];
  if IsZero(ll2.B) then result := result+[lbLine2ParaY];

  if (lbLine1ParaX in result) or
     (lbLine1ParaY in result) or
     (lbLine2ParaX in result) or
     (lbLine2ParaY in result)
  then begin
    NotReady := YES;

    if (lbLine1ParaX in result) and NotReady
    then begin
      if (lbLine2ParaX in result)
      then begin
        Alpha    := 0;
        result   := result + [lbParallel];
        NotReady := NO;
      end
      else if (lbLine2ParaY in result)
      then begin
        Alpha    := cPi90;
        result   := result + [lbOrthogonal];
        NotReady := NO;
      end 
      else begin
        Alpha    := DoAlphaLin;
        result   := result + [lbIntersect];
        NotReady := NO;
      end;
    end;

    if (lbLine1ParaY in result) and NotReady
    then begin
      if (lbLine2ParaX in result)
      then begin
        Alpha    := cPI90;
        result   := result + [lbOrthogonal];
        NotReady := NO;
      end
      else if (lbLine2ParaY in result)
      then begin
        Alpha    := 0;
        result   := result + [lbParallel];
        NotReady := NO;
      end 
      else begin
        Alpha    := DoAlphaLin;
        result   := result + [lbIntersect];
        NotReady := NO;
      end;
    end;

    if (lbLine2ParaX in result) and NotReady
    then begin
      if (lbLine1ParaX in result)
      then begin
        Alpha    := 0;
        result   := result + [lbParallel];
        NotReady := NO;
      end
      else if (lbLine1ParaY in result)
      then begin
        Alpha    := cPi90;
        result   := result + [lbOrthogonal];
        NotReady := NO;
      end
      else begin
        Alpha    := DoAlphaLin;
        result   := result + [lbIntersect];
        NotReady := NO;
      end;
    end;

    if (lbLine2ParaY in result) and NotReady
    then begin
      if (lbLine1ParaX in result)
      then begin
        Alpha    := cPi90;
        result   := result + [lbOrthogonal];
        NotReady := NO;
      end
      else if (lbLine1ParaY in result)
      then begin
        Alpha    := 0;
        result   := result + [lbParallel];
        NotReady := NO;
      end 
      else begin
        Alpha    := DoAlphaLin;
        result   := result + [lbIntersect];
        NotReady := NO;
      end;
    end;

  end
  else begin
    Alpha    := DoAlphaNor;
    if IsSame(m1,m2)
    then begin
      alpha  := 0;
      result := result + [lbParallel];
    end
    else if IsSame(m1,-(1/m2))
    then begin
      alpha  := cPI90;
      result := result + [lbOrthogonal];
    end
    else begin
      result   := result + [lbIntersect];
    end;
  end;
end;

function  FindLineIntersection(ll1,ll2:TLineLinear;var intersect:TSimplePoint;var TanAlpha:Double):TLinesBehaves;
var
  D,DX,DY : Double;
  hp1,hp2 : TSimplePoint;
begin
  result := [];
  hp1.x := ll1.A; hp1.y := ll2.A;
  hp2.x := ll1.B; hp2.y := ll2.B;
  D := Det2x2(hp1,hp2);
  if (D<>0)
  then begin
    hp1.x := ll1.C; hp1.y := ll2.C;
    hp2.x := ll1.B; hp2.y := ll2.B;
    DX := Det2x2(hp1,hp2);

    hp1.x := ll1.A; hp1.y := ll2.A;
    hp2.x := ll1.C; hp2.y := ll2.C;
    DY := Det2x2(hp1,hp2);

    intersect.x := -(1/D)*DX;
    intersect.y := -(1/D)*DY;
  end;
  result := CheckLineLinBehaviour(ll1,ll2,TanAlpha);
end;