Окружность и точки Опции

[Akara]

Вот такая вот задачка:

Есть множество точек М в трехмерном пространстве. Найти такую из них, что окружность  радиуса R с центром в этой точке содержит максимальное число точек из множества М.
Ну, и её нужно оформить в Делфи.
Спасибочки большое за внимание!

[Shadow]

:D
-=-=-=
Ню я вроде замоснтрячил
только вот лучше мне тебе скинуть
весь проект целиком
иначе неудобно будет

Где у тебя МЫЛО-то

-=-=-=-=

unit Star1;

interface

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

type
  TForm1 = class(TForm)
    BitBtn1: TBitBtn;
    Memo1: TMemo;
    Label1: TLabel;
    GroupBox1: TGroupBox;
    Edit1: TEdit;
    e_X: TEdit;
    e_Y: TEdit;
    e_Z: TEdit;
    e_Name: TEdit;
    le_Radius: TLabeledEdit;
    Button1: TButton;
    Label2: TLabel;
    Label3: TLabel;
    Label4: TLabel;
    Label5: TLabel;
    e_max: TEdit;
    Label6: TLabel;
    Label7: TLabel;
    Image1: TImage;
    procedure BitBtn1Click(Sender: TObject);
    procedure Memo1KeyPress(Sender: TObject; var Key: Char);
    procedure le_RadiusKeyPress(Sender: TObject; var Key: Char);
    procedure Button1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

Type
  StarS = record
  stX           :       Integer;
  stY           :       Integer;
  stZ           :       Integer;
  stName        :       String;
end;

Type
  St_M = record
  St_Col : Integer;
  St_Nam : String;
end;

var
  Form1          : TForm1;
  max_o          : String;
  StrRead        : String;
  Ps,ii          : Integer;
  StarCoo        : array [0..20,0..2] of Integer;
  StarName       : array [0..20] of String;
  StarStatic     : StarS;
  StarWrToMass   : StarS;
//---------------------------------
  Stars_Schet    : Integer;
  Star_M         : array [0..20] of St_M;
//---------------------------------
  //Label ex;

implementation

{$R *.dfm}

procedure TForm1.BitBtn1Click(Sender: TObject);
Var
 i,ir : Integer;
 X_r  : Integer;
 Y_r  : Integer;
 Z_r  : Integer;
 max  : Integer;
 Label ex;

begin  {0}

if Form1.le_Radius.Text='' then
  begin
    Windows.Beep(4000,100);
    ShowMessage('Радиус не введен');
    goto ex;
  end;
  
 {*****************************
 *       Вводим точки         *
 *    на компонент TMemo      *
 ******************************}
 if Form1.Memo1.Lines.Capacity>20 then
   begin
     ShowMessage('Слишком много данных не более 20 строк');
     goto ex;
   end else if Form1.Memo1.Lines.Count=0 then
     begin
      ShowMessage('Нет строк');
      goto ex;
     end else begin {1}
//----------------------------------------------------
For i:=0 to Form1.Memo1.Lines.Capacity-1 do
  begin {2}
           StrRead:=Form1.Memo1.Lines[i];

           if length(StrRead)>15 then
             begin
                ShowMessage('Строка слишком большая не более 15 символов');
                goto ex;
             end else if length(StrRead)<8 then
               begin
                 ShowMessage('Строка слишком маленькая не менее 9 символов');
                 goto ex;
               end;

 {Находим координату X}
           Ps:=pos('>',StrRead);

           if Ps=0 then
             begin
               ShowMessage('в строке нет управляющих символов');
               goto ex;
             end else if Ps>4 then
               begin
                 ShowMessage('     Координата звезды  X   '+#13#10+
                             'не более 3 символов и знак >');
                 goto ex;                             
               end;

           Ps:=Ps-1;
           StarWrToMass.stX:=StrToInt(copy(StrRead, 1, Ps));

           PS:=Ps+1;
           delete(StrRead,1,Ps);

  {КОНЕЦ}
  {Находим координату Y}
           Ps:=pos('>',StrRead);

           if Ps=0 then
             begin
               ShowMessage('в строке нет управляющих символов');
               goto ex;
             end else if Ps>4 then
               begin
                 ShowMessage('     Координата звезды  Y   '+#13#10+
                             'не более 3 символов и знак >');
                 goto ex;                             
               end;

           Ps:=Ps-1;
           StarWrToMass.stY:=StrToInt(copy(StrRead, 1, Ps));

           PS:=Ps+1;
           delete(StrRead,1,Ps);
  {КОНЕЦ}
  {Находим координату Y}
           Ps:=pos('>',StrRead);

           if Ps=0 then
             begin
               ShowMessage('в строке нет управляющих символов');
               goto ex;
             end else if Ps>4 then
               begin
                 ShowMessage('     Координата звезды Z    '+#13#10+
                             'не более 3 символов и знак >');
                 goto ex;                             
               end;
           Ps:=Ps-1;
           StarWrToMass.stZ:=StrToInt(copy(StrRead, 1, Ps));

           PS:=Ps+1;
           delete(StrRead,1,Ps);
  {КОНЕЦ}
  {Находим наконец ИМЯ звезды}
           Ps:=pos('>',StrRead);

           if Ps=0 then
             begin
               ShowMessage('в строке нет управляющих символов');
               goto ex;
             end else if Ps>3 then
               begin
                 ShowMessage('  Имя звезды не боле  '+#13#10+
                             'двух символов и знак >');
                 goto ex;                             
               end;

           Ps:=Ps-1;
           StarWrToMass.stName:=copy(StrRead, 1, Ps);
           PS:=Ps+1;
           delete(StrRead,1,Ps);
  {КОНЕЦ}
     
  {Пишем все это в массив}
         StarCoo[i,0]:=StarWrToMass.stX;
         StarCoo[i,1]:=StarWrToMass.stY;
         StarCoo[i,2]:=StarWrToMass.stZ;

         StarName[i]:=StarWrToMass.stName
      end;
    end;
{*************************************
 *                                   *
 *  Начинаем поиск звезды масимально *
 *  включающим в свой радиус других  *
 *  звезд                            *
 *                                   *
 *************************************}

   
For ir:=0 to Form1.Memo1.Lines.Capacity-1 do
  begin
    StarStatic.stX:=StarCoo[ir,0];
    StarStatic.stY:=StarCoo[ir,1];
    StarStatic.stZ:=StarCoo[ir,2];
    StarStatic.stName:=StarName[ir];
//---------------------------------
    Stars_Schet:=0; //на каждую звезду по св счетчику

   For i:=0 to Form1.Memo1.Lines.Capacity-1 do
     begin
      {******************************
       **что бы не провер саму себя**
       ******************************}

       if ir<>i then
       begin
         StarWrToMass.stX:=StarCoo[i,0];
         StarWrToMass.stY:=StarCoo[i,1];
         StarWrToMass.stZ:=StarCoo[i,2];
//----------------------------------------
        StarWrToMass.stName:=StarName[ii];

         X_r:=StarStatic.stX-StarWrToMass.stX;
         Y_r:=StarStatic.stY-StarWrToMass.stY;
         Z_r:=StarStatic.stZ-StarWrToMass.stZ;
         
         if X_r<0 then X_r:=X_r*(-1); //Корректировка результ
         if Y_r<0 then Y_r:=Y_r*(-1); //чтоб небыл отрицат
         if Z_r<0 then Z_r:=Z_r*(-1); //т.к. он тогда ... ну понятно

         Form1.e_X.Text:=IntToStr(X_r);
         Form1.e_Y.Text:=IntToStr(Y_r);
         Form1.e_Z.Text:=IntToStr(Z_r);
//         ShowMessage('Счет');

         if X_r<=StrToInt(Form1.le_Radius.Text) then
          if Y_r<=StrToInt(Form1.le_Radius.Text) then
           if Z_r<=StrToInt(Form1.le_Radius.Text) then
              begin
//                ShowMessage('Есть попадание по коор Х'+#10#13+
//                            'Есть попадание по коор Y'+#10#13+
//                            'Есть попадание по коор Z');

                Stars_Schet:=Stars_Schet+1;
              end;
              
 {****************
  * Конец поиска *
  ****************}

       end;
   end;

// прячем в массиве : )

 Star_M[ir].St_Col:=Stars_Schet;
 Star_M[ir].St_Nam:=StarStatic.stName;

 end;
{******************************
 * А вот теперь ищем максимум *
 ********************************************************
 * оно и будет максим звездой  * если ничего не напутал *
 *******************************************************}
  max:=Star_M[0].St_Col;

  For i:=0 to Form1.Memo1.Lines.Capacity-1 do
     begin

      if Star_M[i].St_Col>max then

        begin

         max:=Star_M[i].St_Col;

//         max_o:=IntToStr(max)+'...'+Star_M[i].St_Nam;

        end;
     end;
//Вдруг несколько звездочек будут одинаковы тоже выведем
  For i:=0 to Form1.Memo1.Lines.Capacity-1 do
   begin

     if Star_M[i].St_Col=max then
       begin
         max_o:=max_o+(IntToStr(max)+'...'+Star_M[i].St_Nam+'.'+#32#32#32);
       end;
   end;
  ex:
 end;
{************************
 *  Пример ввода чисел  *
 * 3>13>3>s1>           *
 * 19>9>9>s2>           *
 * 22>2>22>s3>          *
 * 11>16>11>s4>         *
 * 43>3>3>s5>           *
 * 9>29>39>s6>          *
 * 21>12>2>s7>          *
 * 11>1>11>s8>          *
 * 3>3>3>s9>            *
 * 19>19>9>a1>          *
 * 2>2>22>a2>           *
 * 31>13>13>a3>         *
 * 43>13>43>a4>         *
 * 15>15>9>a5>          *
 * 22>22>22>a6>         *
 * 15>19>11>a7>         *
 ************************}

procedure TForm1.Memo1KeyPress(Sender: TObject; var Key: Char);
begin
{****************************************
 * Замонстрячим защиту от неправильного *
 * ввода данных                         *
 *                                      *
 ****************************************}

 Case Key of
  'a'..'z' :;
  '0'..'9' :;
  'A'..'Z' :;
  Chr(13)  :;
  Chr(8)   :;
  '>'      :;
  else
    begin
      Key :=Chr(0); // символ не отображать
      ShowMessage('      Можно вводить     '+#10+#13+
                  'только с a-z A-Z 0-1 и >');
    end;

 end;
end;

procedure TForm1.le_RadiusKeyPress(Sender: TObject; var Key: Char);
begin
 Case Key of
   '0'..'9' :;
   else begin
      Key :=Chr(0); // символ не отображать
      ShowMessage('Только цифры 0-9');
        end;
 end;
end;

procedure TForm1.Button1Click(Sender: TObject);
 Var
  it    : Integer;
  fg    : String;
begin

{*************************************
 * Для отладки что унас в массиве-то *
 *                                   *
 ****************i*********************}
 for it:=0 to Form1.Memo1.Lines.Capacity-1 do
  begin
   fg:=fg+#32#32+IntToStr(Star_M[it].St_Col)+'..'+Star_M[it].St_Nam;
  end;

  Form1.Edit1.Text:=fg;

  Form1.e_max.Text:=max_o;

//  ss:=StrToInt(Form1.le_Radius.Text);
//  Form1.e_X.Text:=IntToStr(StarCoo[ss,0]);
//  Form1.e_Y.Text:=IntToStr(StarCoo[ss,1]);
//  Form1.e_Z.Text:=IntToStr(StarCoo[ss,2]);


// form1.Edit1.Text:=IntToStr(Form1.Memo1.Lines.Capacity);
end;

end.