Schnittpunkte beliebiger Polygone mit einem beliebigem Achsen-parallelem Rechteck

[ohkay]

danke für eure hilfe ich habe eine elegante lösung gefunden dank euch

Delphi-Quellcode:

procedure Schnittpunkt(x1,y1,x2,y2,x3,y3,x4,y4:integer;var xs,ys:integer; var ok:boolean);
  var
      d:integer; t1,t2:real;
 function det (a,b,c,d:integer):integer;
  begin
      det:=a*d-b*c;
  end;
  begin
      d:= det(x2-x1,x3-x4,y2-y1,y3-y4);
      ok:= false;
      if d<>0 then
      begin
          t1:=det(x3-x1,x3-x4,y3-y1,y3-y4)/d;
          t2:=det(x2-x1,x3-x1,y2-y1,y3-y1)/d;
          if (t1>=0) and (t1<=1) and (t2>=0) and (t2<=1) then

          begin
              xs:=x1+round(t1*(x2-x1));
              ys:=y1+round(t1*(y2-y1));
              ok:=true;
          end;
      end;
  end;

//die anwendung der funktion für mein problem
{procedure TForm1.Button3Click(Sender: TObject);                                 //schnittpunkte anzeigen
 var
    i:integer;
    xs,ys:integer;
    ok:boolean;

  begin
      xp[n+1]:=xp[1];
      yp[n+1]:=yp[1];
      for i := 1 to n do
      begin
      image1.Canvas.Pen.Color:=clred;
          Schnittpunkt(xp[i],yp[i],xp[i+1],yp[i+1],xmin,ymin,xmax,ymin,xs,ys,ok);  //schnitpunkte oben
          if ok  then
          begin
              image1.Canvas.Rectangle(xs-3,ys-3,xs+3,ys+3)
          end;
          Schnittpunkt(xp[i],yp[i],xp[i+1],yp[i+1],xmax,ymin,xmax,ymax,xs,ys,ok);  //schnitpunkte rechts
          if ok  then
          begin
              image1.Canvas.Rectangle(xs-3,ys-3,xs+3,ys+3)
          end;
          Schnittpunkt(xp[i],yp[i],xp[i+1],yp[i+1],xmax,ymax,xmin,ymax,xs,ys,ok);   //schnitpunkte unten
          if ok  then
          begin
              image1.Canvas.Rectangle(xs-3,ys-3,xs+3,ys+3)
          end;
          Schnittpunkt(xp[i],yp[i],xp[i+1],yp[i+1],xmin,ymax,xmin,ymin,xs,ys,ok);   //schnitpunkte links
          if ok  then
          begin
              image1.Canvas.Rectangle(xs-3,ys-3,xs+3,ys+3)
          end;
      end;
  end;}
end.

das wars schon, ich hoffe es hilft auch mal anderen
dank noch mal an alle




mfg martin