Delphi-Help

unit Unit1;

interface

uses

  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,

  Dialogs, Menus, ExtCtrls, StdCtrls, TeEngine, Series, TeeProcs, Chart;

type // точка на плоскости

  Point = record

    X : Extended;

    Y : Extended;

  end;

  TForm1 = class(TForm)

    MainMenu1: TMainMenu;

    N1: TMenuItem;

    N2: TMenuItem;

    OpenDialog1: TOpenDialog;

    Panel1: TPanel;

    Memo1: TMemo;

    Button1: TButton;

    Button2: TButton;

    SaveDialog1: TSaveDialog;

    Chart1: TChart;

    Series1: TPointSeries;

    Button3: TButton;

    Series2: TPointSeries;

    Label1: TLabel;

    Series3: TLineSeries;

    Button4: TButton;

    procedure N2Click(Sender: TObject);

    procedure Button1Click(Sender: TObject);

    procedure Button2Click(Sender: TObject);

    function ParseString(str: string;var cnt:integer):TStringlist;

    procedure Button3Click(Sender: TObject);

    function FindCentreCircle(a,b,c : Point; var r : extended):Point;

    function SquareThreeAngle(a,b,c : Point): extended;

    function InTA(a,b,c,O : Point): boolean;

    procedure Button4Click(Sender: TObject);

  private

    { Private declarations }

  public

    { Public declarations }

  end;

var

  Form1: TForm1;

  pnts : array of Point;

implementation

uses Math;

{$R *.dfm}

procedure TForm1.N2Click(Sender: TObject);

// открываем файл посредством компонента SaveDialog

begin

  memo1.Lines.Clear;

  if OpenDialog1.Execute then 

 //открываем диалог для выбора файла и загружаем содержимое в memo1

    Memo1.Lines.LoadFromFile(OpenDialog1.FileName);

end;

procedure TForm1.Button1Click(Sender: TObject);

// считываем в массив координаты из файла загруженного в memo

var i,cnt,tmp : integer;          

//  считать координаты из memo1 в массив точек pnts

    workarray : TStringList;

begin

  if Memo1.Lines.Count = 0 then // если файл пуст, то завершаем

    Exit;

  cnt := StrToInt(Memo1.Lines[0]);

  Series1.Clear;

  Series2.Clear;

  Series3.Clear;

  SetLength(pnts,cnt);

 // указываем длину массива значением из первой строчки файла

  for i := 1 to cnt do

    begin

      workarray := ParseString(memo1.Lines[i],tmp);

// используем функцию разделения строки на слова, то есть получаем 2 координаты

      pnts[i-1].X := StrToInt(workarray[0]);

      pnts[i-1].Y := StrToInt(workarray[1]);

      Series1.AddXY(pnts[i-1].X,pnts[i-1].Y)// выводим точки на график

    end;

end;

function TForm1.ParseString(str: string;var cnt:integer):TStringlist;

// функцию разделения строки на слова

var strs : TStringlist;

    tmp  : string;

    i,j  : integer;

begin

  strs := TStringlist.Create;

  i := 1;

  j := 1;

  repeat

    if (str[i] = ';')or(i = Length(str)+1) then 

// если в строке попадается символ ; или конец строки,

// то они являются делителем строки на слова

      begin

        tmp := Copy(str,j,i-j);

        strs.Add(tmp);

        j := i+1

      end;

    inc(i);

  until i > Length(str)+1;

  cnt := strs.Count;

  result := strs;

end;

procedure TForm1.Button2Click(Sender: TObject);

// дополнительная функция для создания файла с координатами

var i,r1,r2 : integer;   

// метод для создания файла со случайными координатами,

// необходим, чтобы быстро получить необходимый файл)

begin

  memo1.Lines.Clear;

  memo1.Lines.Add('21');

  randomize;

  for i:=0 to 20 do

    begin

      r1 := Random(20)-10;

      r2 := Random(20)-10;

      memo1.Lines.Add(IntToStr(r1)+';'+IntToStr(r2));

    end;

  if SaveDialog1.Execute then

    memo1.Lines.SaveToFile(SaveDialog1.FileName);

end;

procedure TForm1.Button3Click(Sender: TObject);

// определяем окружность и треугольник

var i,j,k,n,cnt1,cnt2,cnttmp,cnttemp : integer;

    fi,Sq,rtmp,r  : extended;

    p : array [0..3] of Point;

    p0 : Point;

begin

  cnt1 := 0;

  cnt2 := 0;

  r := 2;

  Series2.Clear;

  Series3.Clear;

  for i := 0 to Length(pnts)-3 do 

// пробегаемся по всем неповторяющимся тройкам точек

    for j:= i+1 to Length(pnts)-2 do

      for k:= j+1 to Length(pnts)-1 do

        begin

//          if (i=0)and(j=29)and(k=100) then

//            rtmp := 0;

          Sq := SquareThreeAngle(pnts[i],pnts[j],pnts[k]);

// определяем, не лежат ли 3 точки на одной прямой, то есть

// находим площадь треугольника, и если она > 0, 

// значит не лежат 3 точки на 1 прямой

          if Sq > 0.001 then

              begin                                                   

                p0 := FindCentreCircle(pnts[i],pnts[j],pnts[k],rtmp); 

// Используем функция для определения центра окружности и радиуса

//                Label1.Caption := IntToStr(i)+' '+IntToStr(j)+' '+IntToStr(k);

                cnttmp := 0;

                for n:=0 to Length(pnts)-1 do 

// проверяем какие точки лежат на окружности

                  if (n<>i)and(n<>j)and(n<>k) then

                    if (sqrt(sqr(pnts[n].X-p0.X)+sqr(pnts[n].Y-p0.Y))< rtmp)then 

// То есть подставляем координаты точки в уравнение окружности

                      inc(cnttmp);

                cnttemp := 0;

                for n:=0 to Length(pnts)-1 do 

// проверяем какие точки лежат в треугольнике

                  if (n<>i)and(n<>j)and(n<>k) then

                    if (InTA(pnts[i],pnts[j],pnts[k],pnts[n]))then 

// Используем специальную функцию для проверки

                      inc(cnttemp);

                if (cnttmp = cnttemp)and(cnttmp > cnt1)and(cnttemp > cnt2) then 

// проверяем, совпало ли количество точек в треугольнике и круге,

// и максимальное ли это число

                  begin

                    p[0] := p0; //запоминаем максимальное число

                    p[1] := pnts[i];

                    p[2] := pnts[j];

                    p[3] := pnts[k];

                    cnt1 := cnttmp;

                    cnt2 := cnttemp;

                    Label1.Caption := IntToStr(cnttmp)+' '+IntToStr(cnttemp);

                    r := rtmp;

                  end;

              end;

        end;

  fi := 0;

  Series2.AddXY(p[0].X,p[0].Y); // Выводим окружность на график

  Series3.AddXY(p[1].X,p[1].Y);

  Series3.AddXY(p[2].X,p[2].Y);

  Series3.AddXY(p[3].X,p[3].Y);

  while fi < 360 do 

// цикля для вывода окружности используя параметрическое уравнение окружности

    begin

      Series2.AddXY(r*cos(fi)+p[0].X,r*sin(fi)+p[0].Y);

      fi := fi + 0.1;

    end;

end;

function TForm1.FindCentreCircle(a, b, c: Point; var r: Extended): Point; 

// функция нахождения центра окружности построенной на 3х точках

var p0 : Point;

    x1,x2,x3,y1,y2,y3,x0,y0,a1,a2,b1,b2,c1,c2: extended;

begin

  x1 := a.X;

  x2 := b.X;

  x3 := c.X;

  y1 := a.Y;

  y2 := b.Y;

  y3 := c.Y;

  a1 := -2*x1 + 2*x2;

  a2 := -2*x2 + 2*x3;

  b1 := -2*y1 + 2*y2;

  b2 := -2*y2 + 2*y3;

  c1 := (sqr(x2)-sqr(x1)) + (sqr(y2)-sqr(y1));

  c2 := (sqr(x3)-sqr(x2)) + (sqr(y3)-sqr(y2));

  x0 := (b1*c2-b2*c1)/(a2*b1-a1*b2);

  y0 := 0;

  if b1 <> 0 then

    y0 := (c1-a1*x0)/b1;

  if b2 <> 0 then

    y0 := (c2-a2*x0)/b2;

  p0.X := x0;

  p0.Y := y0;  

  r := sqrt(sqr(a.X-p0.X)+sqr(a.Y-p0.Y));

  result := p0;

end;

function TForm1.SquareThreeAngle(a, b, c: Point): extended;

// функция для определения площади треугольника по заданным 

// координатам вершин треугольника

begin

  result := abs((b.X-a.X)*(c.Y-a.Y)-(c.X-a.X)*(b.Y-a.Y))/2;

end;

function TForm1.InTA(a, b, c, O: Point): boolean;

// функция, определяющая расположение точки относительно 

// треугольника (в качестве параметров задаются 3 вершина и искомая точка

var sq,sq1,sq2,sq3 : extended;

begin               

// метод основан на сравнении суммы  площадей 3х 

// полученных треугольников с площадью общего треугольника

    result :=false;

    sq := SquareThreeAngle(a,b,c);

    sq1 := SquareThreeAngle(O,b,c);

    sq2 := SquareThreeAngle(a,O,c);

    sq3 := SquareThreeAngle(a,b,O);

    if abs(sq-(sq1+sq2+sq3)) < 0.000000001 then

      result := true;

end;

procedure TForm1.Button4Click(Sender: TObject);

var i,j,k,n : integer;

begin

  n := 0;

  for i := 3 to Length(pnts)-1 do

    if InTA(pnts[0],pnts[1],pnts[2],pnts[i]) then

      inc(n);

  Label1.Caption := IntToStr(n);

end;

end.