allgemeine Gleichung von Schnitpunkten 2er Kreise ?

[Kroko1999]

Hier meine komplette Testunit:

Delphi-Quellcode:

unit unitTestKreis;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ExtCtrls, Buttons, StdCtrls;

type
  TVektor2D = record
                  X,Y: Extended;
                end;
  TKreis2D = record
               M: TVektor2D;
               R: Extended;
             end;

  TForm1 = class(TForm)
    PaintBox1: TPaintBox;
    SpeedButton1: TSpeedButton;
    SpeedButton2: TSpeedButton;
    Label1: TLabel;
    Label2: TLabel;
    Label3: TLabel;
    Label4: TLabel;
    procedure PaintBox1Paint(Sender: TObject);
    procedure SpeedButton1Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure SpeedButton2Click(Sender: TObject);
  private
    { Private-Deklarationen }
    FCircle: Boolean;
    Kreis1,
    Kreis2: TKreis2D;
  public
    { Public-Deklarationen }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}
uses
  Math;

const
  coMx = 300;
  coMy = 300;

procedure Kreisschnittpunkte (AK1,AK2: TKreis2D; var P1,P2: TVektor2D);
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.M.X;
  C1 := -2*AK1.M.Y;
  A2 := -2*AK2.M.X;
  C2 := -2*AK2.M.Y;
  // x²+ax+y²+cy=f f=e-b-d
  F1 := Sqr(AK1.R)-Sqr(AK1.M.X)-Sqr (AK1.M.Y);
  F2 := Sqr(AK2.R)-Sqr(AK2.M.X)-Sqr (AK2.M.Y);
  // 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.M.X))+AK1.M.Y;
      P2.Y := -Sqrt(Sqr(AK2.R)-Sqr(P2.X-AK2.M.X))+AK2.M.Y;
    end
  else
    if Math.IsZero(D,1E-08) then
      begin
        P1.X := -P/2;
        P1.Y := Sqrt(Sqr(AK1.R)-Sqr(P1.X-AK1.M.X))+AK1.M.Y;
      end;
end;

procedure TForm1.PaintBox1Paint(Sender: TObject);
begin
  with PaintBox1.Canvas do
  begin
    Brush.Color := clInfoBk;
    FillRect (PaintBox1.ClientRect);
    if FCircle then
      begin
        Brush.Style := bsClear;
        Pen.Color := ClRed;
        Ellipse (Round (coMx+Kreis1.M.X-Kreis1.R),
                 Round (coMy+Kreis1.M.Y-Kreis1.R),
                 Round (coMx+Kreis1.M.X+Kreis1.R),
                 Round (coMy+Kreis1.M.Y+Kreis1.R));
        Pen.Color := ClBlue;
        Ellipse (Round (coMx+Kreis2.M.X-Kreis2.R),
                 Round (coMy+Kreis2.M.Y-Kreis2.R),
                 Round (coMx+Kreis2.M.X+Kreis2.R),
                 Round (coMy+Kreis2.M.Y+Kreis2.R));
        Pen.Color := clBlack;
        MoveTo (coMx,0);
        Lineto (coMx,PaintBox1.Height);
        Moveto (0,coMy);
        LineTo (PaintBox1.Width,coMy);
      end;
  end;
end;

procedure TForm1.SpeedButton1Click(Sender: TObject);
begin
  FCircle := True;
  PaintBox1.Invalidate;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  Kreis1.M.X := 100;
  Kreis1.M.Y := 100;
  Kreis1.R := 80;
  Kreis2.M.X := 200;
  Kreis2.M.Y := 120;
  Kreis2.R := 60;
end;

procedure TForm1.SpeedButton2Click(Sender: TObject);
var
  P1,P2: TVektor2D;
begin
  Kreisschnittpunkte (Kreis1,Kreis2,P1,P2);
  Label1.Caption := FloatToStr (P1.X);
  Label2.Caption := FloatToStr (P1.Y);
  with PaintBox1.Canvas do
  begin
    Pen.Color := clGReen;
    MoveTo (0,coMy+Round(P1.Y));
    LineTo (PaintBox1.Width,coMy+Round(P1.Y));
    MoveTo (coMx+Round(P1.X),0);
    LineTo (coMx+Round(P1.X),PaintBox1.Height);
  end;
  Label3.Caption := FloatToStr (P2.X);
  Label4.Caption := FloatToStr (P2.Y);
  with PaintBox1.Canvas do
  begin
    Pen.Color := clPurple;
    MoveTo (0,coMy+Round(P2.Y));
    LineTo (PaintBox1.Width,coMy+Round(P2.Y));
    Moveto (coMx+Round(P2.X),0);
    Lineto (coMy+Round(P2.X),PaintBox1.Height);
  end;
end;

end.