Einzelnen Beitrag anzeigen

Benutzerbild von Kroko1999
Kroko1999

Registriert seit: 21. Apr 2005
Ort: Spremberg
455 Beiträge
 
Turbo Delphi für Win32
 
#7

Re: allgemeine Gleichung von Schnitpunkten 2er Kreise ?

  Alt 26. Apr 2005, 14:59
Delphi-Quellcode:
  TPunkt = record
             X,Y: real;
           end;
  TKreis = record
             Mx,My: Integer;
             R: Word;
           end;

procedure Kreisschnittpunkte (AK1,AK2: TKreis; var P1,P2: TPunkt);
var
  A1,C1,F1,
  A2,C2,F2,
  A,C,F,
  Ha,Hb,Hc,P,Q,D: Real;
begin
  P1.X := NAN; //keine Lösung
  P2.X := NAN; //keine Lösung
  // x²+ax+b+y²+cy+d=e
  A1 := -2*AK1.Mx;
  C1 := -2*AK1.My;
  A2 := -2*AK2.Mx;
  C2 := -2*AK2.My;
  // x²+ax+y²+cy=f f=e-b-d
  F1 := Sqr(AK1.R)-Sqr(AK1.Mx)-Sqr (AK1.My);
  F2 := Sqr(AK2.R)-Sqr(AK2.Mx)-Sqr (AK2.My);
  // x²+ax+y²+cy-f=x²+ax+y²+cy-f
  // nach Y umstellen
  C := (C1-C2);
  A := (A2-A1)/C;
  F := (F1-F2)/C;
  // y= ax+f
  // in Kreis 1 einsetzen
  Ha := Sqr(A)+1;
  Hb := A1+2*A*F+C1*A;
  Hc := Sqr(F)+C1*F-F1;
  // Normalform
  P := Hb/Ha;
  Q := Hc/Ha;
  // lösen
  D := Sqr(P/2)-Q;
  if D>0 then
    begin
      P1.X := -P/2-Sqrt(D);
      P2.X := -P/2+Sqrt(D);

      P1.Y := +Sqrt(Sqr(AK1.R)-Sqr(P1.X-AK1.Mx))+AK1.My;
      P2.Y := -Sqrt(Sqr(AK2.R)-Sqr(P2.X-AK2.Mx))+AK2.My;
    end
  else
    if Math.IsZero(D,1E-08) then
      begin
        P1.X := -P/2;
        P1.Y := Sqrt(Sqr(AK1.R)-Sqr(P1.X-AK1.Mx))+AK1.My;
      end;
end;
liefert die Schnittpunkte im 1.Quadranten, ansonsten Vorzeichen der Wurzel für P.Y ändern!

viel Spaß


//EDIT: Optimierungen sind absichtlich weggelassen
  Mit Zitat antworten Zitat