Schnittpunkte beliebiger Polygone mit einem beliebigem Achsen-parallelem Rechteck

[Bummi]

Funktioniert einwandfrei Martin, ich hätte noch eine Version mit einer leicht geänderten Schreibweise

Delphi-Quellcode:

Function Schnittpunkt(v1, b1, v2, b2: TPoint; var ResultPoint: TPoint): Boolean;

  function det(a, b, c, d: Integer): Integer;
  begin
    Result := a * d - b * c;
  end;

var
  d: Integer;
  t1, t2: Double;
begin
  d := det(b1.X - v1.X, v2.X - b2.X, b1.Y - v1.Y, v2.Y - b2.Y);
  if d <> 0 then
  begin
    t1 := det(v2.X - v1.X, v2.X - b2.X, v2.Y - v1.Y, v2.Y - b2.Y) / d;
    t2 := det(b1.X - v1.X, v2.X - v1.X, b1.Y - v1.Y, v2.Y - v1.Y) / d;
    Result := (t1 >= 0) and (t1 <= 1) and (t2 >= 0) and (t2 <= 1);
    if Result then
    begin
      ResultPoint.X := v1.X + round(t1 * (b1.X - v1.X));
      ResultPoint.Y := v1.Y + round(t1 * (b1.Y - v1.Y));
    end;
  end;
end;

procedure TForm2.FormMouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  if Tag = 0 then
  begin
    P1.X := X;
    P1.Y := Y;
  end
  else
  begin
    p3.X := X;
    p3.Y := Y;
  end;
end;

procedure TForm2.FormMouseMove(Sender: TObject; Shift: TShiftState;
  X, Y: Integer);
begin
  if ssLeft in Shift then
  begin
    if Tag = 0 then
    begin
      p2.X := X;
      p2.Y := Y;
    end
    else
    begin
      p4.X := X;
      p4.Y := Y;
    end;
  end;
  invalidate;
end;

procedure TForm2.FormMouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  if Tag = 0 then
    Tag := 1
  else
    Tag := 0;

end;

procedure TForm2.FormPaint(Sender: TObject);
var
  sp: TPoint;
begin
  Canvas.MoveTo(P1.X, P1.Y);
  Canvas.LineTo(p2.X, p2.Y);
  Canvas.MoveTo(p3.X, p3.Y);
  Canvas.LineTo(p4.X, p4.Y);
  if Schnittpunkt(P1, p2, p3, p4, sp) then
  begin
    Canvas.Ellipse(sp.X - 5, sp.Y - 5, sp.X + 5, sp.Y + 5);
  end;
end;