Задачка из геометрии: кто подскажет?

xKVtor Ну не знаю... По твоим формулам у меня вообще выходило нечто жуткое, типа -90372, -285793644. На опечатки при набивке формул проверял несколько раз, но где прятались грабли - так и не нашел.

PS Еще раз спасибо всем принимавшим участие.

Хоть минус три мильярда! Если в процедуре CHECK получается три одинаковых радиуса, то значит все верно, таки и должно быть.

На картинке-то ? Ну не знаю, специально жирным выделил x0

Хотя, теперь уже неважно, все равно мои формулы забраковали

Такие дикие результаты у меня получались после перевода формул с картинки в программу. Причем при одних и тех же исходных данных ответы были каждый раз разные Мистика, вобщем. Или то, что я вместо extended использовал real

Так что я сам где-то намудрил. Правда где - так и не понял. :oops: Наверное, зимний авитаминоз на мозги давит

DanZer напутал с координатами по Y
при выводе везде надо 'ymax-' подставлять, и ёще вроде где-то индексы перепутал. вот попробуй, тока с делением на ноль сам уж доведи...

дебаг версия:

unit Unit2;

interface

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

type
  TForm1 = class(TForm)
    Button1: TButton;
    Label1: TLabel;
    Label2: TLabel;
    Label3: TLabel;
    procedure Button1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;
 a:array [1..6] of array [1..2] of integer; // координаты точек закинуты в массив a[1,1]=x1, a[1,2]=y1, a[2,1]=x2 и т.д.
 MyMetafile: TMetafile;
 b1,b2,k1,k2,xa,ya,xb,yb:real;
 i:byte;
const
 YMax: Integer = 400;


implementation

{$R *.dfm}
procedure TForm1.Button1Click(Sender: TObject);
begin

{т.к. ось OY идет сверху вниз, значение Y отнимаем от Ymax,
чтобы график рисовался как положено, а не вверх ногами}

 a[1,1]:=119;
 a[1,2]:=ymax-85;

 a[2,1]:=257;
 a[2,2]:=ymax-201;

 a[3,1]:=166;
 a[3,2]:=ymax-271;


 //****************************************
 k1:=(a[3,1]-a[2,1]) / (a[2,2]-a[3,2]);
 k2:=(a[1,1]-a[3,1]) / (a[3,2]-a[1,2]);

 xa:=( (a[2,1] + a[3,1]) / 2 );
 ya:=( (a[2,2] + a[3,2]) / 2 );

 xb:=( (a[3,1] + a[1,1]) / 2 );
 yb:=( (a[3,2] + a[1,2]) / 2 );

 b1:=ya - k1*xa;
 b2:=yb - k2*xb;

{и, наконец, вычисляем координаты центра окружности}
 a[5,1]:=round( (b2 - b1) / (k1 - k2) ); {это x0}
 a[5,2]:=round( k1 * a[5,1] + b1 ); {а это y0}
 //***********************************

 if round( k1*a[5,1]+b1) = round( k2*a[5,1]+b2)
 then Label2.Caption := 'True'
 else Label2.Caption := 'False';


 //**********************
 k1:=(a[1,1]-a[3,1]) / (a[3,2]-a[1,2]);
 k2:=(a[2,1]-a[1,1]) / (a[1,2]-a[2,2]);

 xa:=( (a[3,1] + a[1,1]) / 2 );
 ya:=( (a[3,2] + a[1,2]) / 2 );

 xb:=( (a[1,1] + a[2,1]) / 2 );
 yb:=( (a[1,2] + a[2,2]) / 2 );

 b1:=ya-k1*xa;
 b2:=yb-k2*xb;

 {и, наконец, вычисляем координаты центра окружности}
 a[6,1]:=round( (b2 - b1) / (k1 - k2) ); {это x0}
 a[6,2]:=round( k1 * a[6,1] + b1 ); {а это y0}


 //***********************************

 if round( k1*a[6,1]+b1) = round( k2*a[6,1]+b2)
 then Label3.Caption := 'True'
 else Label3.Caption := 'False';
if a[1,2] <> a[2,2]
 then  k1:=(a[2,1]-a[1,1]) / (a[1,2]-a[2,2])
 else  k1:= 0;

if a[3,2] <> a[2,2]
 then  k2:=(a[3,1]-a[2,1]) / (a[2,2]-a[3,2])
 else  k2:= 0;


 xa:=( (a[1,1] + a[2,1]) / 2 );
 ya:=( (a[1,2] + a[2,2]) / 2 );

 xb:=( (a[2,1] + a[3,1]) / 2 );
 yb:=( (a[2,2] + a[3,2]) / 2 );

 b1:=ya-k1*xa;
 b2:=yb-k2*xb;

 {и, наконец, вычисляем координаты центра окружности}
 a[4,1]:= round( (b2 - b1) / (k1 - k2) ); {это x0}
 a[4,2]:= round( k1 * a[4,1] + b1 ); {а это y0}

 if round( k1*a[4,1]+b1) = round( k2*a[4,1]+b2)
 then Label1.Caption := 'True'
 else Label1.Caption := 'False';

 //**********************


{и выводим результаты на экран}
 MyMetafile := TMetafile.Create;
 for i:=6 downto 1 do
 begin
  with TMetafileCanvas.Create(MyMetafile, 0) do
   try
    if i<4 then Brush.Color := clRed else Brush.Color := clYellow;
    if i=5 then Brush.Color := clBlue;
    if i=6 then Brush.Color := clGreen;

    Ellipse(a[i,1]-i*4,ymax-a[i,2]-i*4,a[i,1]+i*4,ymax-a[i,2]+i*4);

if i<3
then
 begin
   MoveTo(a[i,1],ymax-a[i,2]);
   LineTo(a[i+1,1], ymax-a[i+1,2]);
 end;

if i=3
then
 begin
   MoveTo(a[i,1],ymax-a[i,2]);
   LineTo(a[1,1], ymax-a[1,2]);
 end;

if i=1
then
 begin
   MoveTo( round(xa),ymax-round(ya) );
   LineTo( round(xa-50),ymax-round(k1*(xa-50)+b1) );

   MoveTo( round(xb),ymax-round(yb) );
   LineTo( round(xb-50),ymax-round(k2*(xb-50)+b2) );

 end;



   finally
     Free;
  end;
  Form1.Canvas.Draw(0,0,MyMetafile);
 end;
end;



end.

Да ладно, я уже успел нагло передрать функции X0 и Y0 из поста xKVtor'а прикрутить их к своей программке. Все сошлось. Теперь осталось только комментарии добить и прочее мелкое украшательство, типа генерации координат точек случайным образом. Но с этим я как-нибудь и сам справлюсь! :twisted:

unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    procedure FormCreate(Sender: TObject);
    procedure Button1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;
  c:integer;
  a:array [1..4] of array [1..2] of integer;
implementation

uses Unit2;

{$R *.dfm}

Function X0:extended;
Var
 chisl,znam:longint;
Begin
  chisl:=(a[3,2]-a[2,2])*(a[1,1]*a[1,1]+a[1,2]*a[1,2])+(a[1,2]-a[3,2])*(a[2,1]*a[2,1]+a[2,2]*a[2,2])+
(a[2,2]-a[1,2])*(a[3,1]*a[3,1]+a[3,2]*a[3,2]);
  znam :=2*((a[1,2]-a[2,2])*(a[1,1]-a[3,1])-(a[1,2]-a[3,2])*(a[1,1]-a[2,1]));
  X0:=chisl/znam;
End;

Function Y0(x0:extended):extended;
Var
 chisl,znam:extended;
Begin
  chisl:=a[1,1]*a[1,1]-a[2,1]*a[2,1]+a[1,2]*a[1,2]-a[2,2]*a[2,2]-2*(a[1,1]-a[2,1])*x0;
  znam :=2*(a[1,2]-a[2,2]);
  Y0:=chisl/znam;
End;

procedure PutCircle(X,Y,R:integer; Solid:Boolean);
const
 YMax: Integer = 400;
var
 MyMetafile: TMetafile; 
begin
 MyMetafile := TMetafile.Create;  
 with TMetafileCanvas.Create(MyMetafile, 0) do
  try
    if Solid then with Brush do
     begin
      Color := clRed;
      Style := bsSolid;
     end
   else
    Brush.Style := bsClear;
   Ellipse(X-R,Ymax-(Y-R),X+R,Ymax-(Y+R));
  finally
   Free;
  end;
  Form1.Canvas.Draw(0,0,MyMetafile);
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
 a[1,1]:=257;
 a[1,2]:=201;
 a[2,1]:=166;
 a[2,2]:=279;
 a[3,1]:=119;
 a[3,2]:=85;
end;

procedure TForm1.Form1Click(Sender: TObject);
var
 i,r:byte;
begin
 a[4,1]:=round(X0);
 a[4,2]:=round(Y0(a[4,1]));

 for i:=1 to 3 do
  begin
   PutCircle(a[i,1],a[i,2],5,True);
  end;
 r:=round(sqrt(sqr((a[1,1]-a[4,1]))+sqr((a[1,2]-a[4,2]))));
 PutCircle(a[4,1],a[4,2],r,False);
end;

end.

DanZer попробуй ка координаты (100,100) (200,101) (200,200) а потом (100,100) (200,100) (200,200)

Добавлено спустя 21 минуту 29 секунд:

Сдаётся мне, что проще через окружности считать, тем более радиус известен из площади. :?

Ну подумаешь, обычное деление на 0, с кем не бывает Все равно домучаю! :twisted:

Добавлено спустя 7 часов 21 минуту 36 секунд:

Вот!

procedure FindCenter(X1,Y1,X2,Y2,X3,Y3:integer);
var
 a1,a2,b1,b2,c1,c2,znam:extended;
 X0,Y0:integer;
begin
 a1:=x2-x1;
 a2:=x3-x1;
 b1:=y2-y1;
 b2:=y3-y1;
 c1:=(a1*(x2+x1)+b1*(y2+y1)) / 2;
 c2:=(a2*(x3+x1)+b2*(y3+y1)) / 2;
 znam:=a1*b2-a2*b1;

 X0:= round((c1*b2 - c2*b1)/znam);
 Y0:= round((a1*c2 - a2*c1)/znam);
end;

Класс! На 0 деление тока для прямой получается

Вам вероятность выпадения сразу трех точек с одинаковыми значениями Х или Y посчитать? Для квадрата 400*400 это будет одна тридцатидвухмиллионная, если я тервер еще не забыл И так еле успел к 8 марта

А если серьезно, эта проблема решается легче легкого: просто проверю, если znam=0 - перегенерю координаты.

Нуля не будет, я об этом говорил, ведь что бы 0 получился, надо чтоб был не треугольник а прямая или две точки с одинаковыми координатами - что тоже прямая