Есть множество точек М в трехмерном пространстве. Найти такую из них, что окружность радиуса R с центром в этой точке содержит максимальное число точек из множества М. Ну, и её нужно оформить в Делфи. Спасибочки большое за внимание!
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;
if Ps=0 then begin ShowMessage('в строке нет управляющих символов'); goto ex; end else if Ps>4 then begin ShowMessage(' Координата звезды Y '+#13#10+ 'не более 3 символов и знак >'); goto ex; end;
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;
{Пишем все это в массив} 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];
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); //т.к. он тогда ... ну понятно
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; {****************************** * А вот теперь ищем максимум * ******************************************************** * оно и будет максим звездой * если ничего не напутал * *******************************************************} 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
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;
Программа делает то что вы ей приказали а не то что бы ВАМ хотелось бы. МЕРФИ --------------------- RTFM - Read the fucking manual --------------------- http://www.livejournal.com/users/lonley_raven/