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

Восстановите пароль или Зарегистрируйтесь на форуме, о проблемах и с заказом рекламы пишите сюда - 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