Форум программистов
 

Восстановите пароль или Зарегистрируйтесь на форуме, о проблемах и с заказом рекламы пишите сюда - alarforum@yandex.ru, проверяйте папку спам!

Вернуться   Форум программистов > Delphi программирование > Общие вопросы Delphi
Регистрация

Восстановить пароль
Повторная активизация e-mail

Купить рекламу на форуме - 42 тыс руб за месяц

Ответ
 
Опции темы Поиск в этой теме
Старый 13.06.2022, 00:27   #1
Bucknall
 
Регистрация: 29.05.2014
Сообщений: 8
Вопрос Массив непересекающихся отрезков

Доброго времени суток, эксперты.

D7. Создаю массив значений типа TRect, для хранения отрезков. Хочу получить генерацию непересекающихся отрезков. Функцию для проверки пересечения отрезков, взял, с небольшой модификацией, отсюда. Отрезки, которые касаются или даже накладываются друг на друга, она не считает пересекающимися, что мне подходит. N задаёт длину массива и число генераций. RadioGroup1 позволяет выбрать, отдельные отрезки будут генерироваться или одна ломаная линия. Но не получается ни группа разрозненных отрезков, ни одна ломаная без самопересечений - что я делаю не так?

Спасибо.

Код:
function CollisionLineFromTRECT(Sect1, Sect2: TRect): boolean;
var v1, v2, v3, v4: double; LA1, LB1, LA2, LB2: TPoint;
begin
  LA1 := Point(Sect1.Left, Sect1.Top);
  LB1 := Point(Sect1.Right, Sect1.Bottom);
  LA2 := Point(Sect2.Left, Sect2.Top);
  LB2 := Point(Sect2.Right, Sect2.Bottom);
  v1 := (lb2.X - la2.X) * (la1.y - la2.y) - (lb2.y - la2.y) * (la1.X - la2.X);
  v2 := (lb2.X - la2.X) * (lb1.y - la2.y) - (lb2.y - la2.y) * (lb1.X - la2.X);
  v3 := (lb1.X - la1.X) * (la2.y - la1.y) - (lb1.y - la1.y) * (la2.X - la1.X);
  v4 := (lb1.X - la1.X) * (lb2.y - la1.y) - (lb1.y - la1.y) * (lb2.X - la1.X);
  CollisionLineFromTRECT := (v1 * v2 < 0) and (v3 * v4 < 0);

end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  Randomize;
end;

procedure TForm1.Button1Click(Sender: TObject);
var i, k, N: Integer; buf_Rect: TRect; arec1: TArrayOfRects;
begin
  N := SpinEdit1.Value;
  k := 0;
  SetLength(arec1, k + 1);
  arec1[0].Left := Random(Image1.ClientWidth);
  arec1[0].Top := Random(Image1.ClientHeight);
  arec1[0].Right := Random(Image1.ClientWidth);
  arec1[0].Bottom := Random(Image1.ClientHeight);
  while k < N do
  begin
    case RadioGroup1.ItemIndex of
      0: begin
          buf_Rect.Left := Random(Image1.ClientWidth);
          buf_Rect.Top := Random(Image1.ClientHeight);
        end;
      1: begin
          buf_Rect.Left := arec1[k].Right;
          buf_Rect.Top := arec1[k].Bottom;
        end;
    end;
    buf_Rect.Right := Random(Image1.ClientWidth);
    buf_Rect.Bottom := Random(Image1.ClientHeight);
    for i := 0 to Length(arec1) - 1 do
      if CollisionLineFromTRECT(arec1[0], buf_Rect)
        then break else
        if i = Length(arec1) - 1 then
        begin
          Inc(k);
          SetLength(arec1, k);
          arec1[k - 1] := buf_Rect;
        end;
  end;
  with Image1.canvas do
  begin
    fillrect(cliprect);
    for i := 0 to Length(arec1) - 1 do
    begin
      MoveTo(arec1[i].Left, arec1[i].Top);
      LineTo(arec1[i].Right, arec1[i].Bottom);
    end;
  end;
end;
Вложения
Тип файла: zip ForNonCrossedSection.zip (7.4 Кб, 1 просмотров)
Тип файла: zip Project1.zip (216.4 Кб, 1 просмотров)

Последний раз редактировалось Bucknall; 13.06.2022 в 00:45. Причина: указал версию Делфи
Bucknall вне форума Ответить с цитированием
Старый 14.06.2022, 14:35   #2
Bucknall
 
Регистрация: 29.05.2014
Сообщений: 8
Хорошо

Всем спасибо, разобрался самостоятельно, привожу исправленный код в обработчике события OnClick:

Код:
procedure TForm1.Button1Click(Sender: TObject);
var i, k, N: Integer; buf_Rect: TRect; arec1: array of TRect;
begin
  N := SpinEdit1.Value;
  k := 0;
  SetLength(arec1, k + 1);
  arec1[0].Left := Random(Image1.ClientWidth);
  arec1[0].Top := Random(Image1.ClientHeight);
  arec1[0].Right := Random(Image1.ClientWidth);
  arec1[0].Bottom := Random(Image1.ClientHeight);
  while k < N do
  begin
    case RadioGroup1.ItemIndex of
      0: begin
          buf_Rect.Left := Random(Image1.ClientWidth);
          buf_Rect.Top := Random(Image1.ClientHeight);
        end;
      1: begin
          buf_Rect.Left := arec1[High(arec1)].Right;
          buf_Rect.Top := arec1[High(arec1)].Bottom;
        end;
    end;
    buf_Rect.Right := Random(Image1.ClientWidth);
    buf_Rect.Bottom := Random(Image1.ClientHeight);
    for i := 0 to Length(arec1) - 1 do
      if CollisionLineFromTRECT(arec1[i], buf_Rect)
        then break else
        if i = Length(arec1) - 1 then
        begin
          Inc(k);
          SetLength(arec1, k);
          arec1[k - 1] := buf_Rect;
        end;
  end;
  with Image1.canvas do
  begin
    fillrect(cliprect);
    for i := 0 to Length(arec1) - 1 do
    begin
      MoveTo(arec1[i].Left, arec1[i].Top);
      LineTo(arec1[i].Right, arec1[i].Bottom);
    end;
  end;
end;
Вложения
Тип файла: zip ForNonCrossedSectionFixed.zip (7.4 Кб, 0 просмотров)

Последний раз редактировалось Bucknall; 14.06.2022 в 14:43.
Bucknall вне форума Ответить с цитированием
Ответ


Купить рекламу на форуме - 42 тыс руб за месяц



Похожие темы
Тема Автор Раздел Ответов Последнее сообщение
Задача. Даны координаты концов четырех отрезков. Выяснить, лежат ли все или некоторые из этих отрезков на пересекающихся прямых Naijl Visual C++ 0 28.11.2016 18:11
Из множества конечных множеств выделить подмножество из наибольшего количества попарно непересекающихся множеств(Maple или Паскаль Моника Помощь студентам 0 28.04.2014 23:18
Пересичение отрезков Lokki23 C++ Builder 9 15.02.2014 14:03
Построение непересекающихся окружностей s77lanselot77s Мультимедиа в Delphi 9 21.05.2012 14:13
Пересечение отрезков BoozZzilla Помощь студентам 3 06.04.2012 13:51