Форум по Delphi программированию

Delphi Sources



Вернуться   Форум по Delphi программированию > Все о Delphi > Графика и игры
Ник
Пароль
Регистрация <<         Правила форума         >> FAQ Пользователи Календарь Поиск Сообщения за сегодня Все разделы прочитаны

Ответ
 
Опции темы Поиск в этой теме Опции просмотра
  #1  
Старый 13.06.2022, 00:44
TennisAdept TennisAdept вне форума
Прохожий
 
Регистрация: 10.06.2021
Сообщения: 2
Версия Delphi: Delphi 7
Репутация: 10
Вопрос Массив непересекающихся отрезков

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

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 Кбайт, 0 просмотров)
Ответить с цитированием
  #2  
Старый 13.06.2022, 07:30
lmikle lmikle вне форума
Модератор
 
Регистрация: 17.04.2008
Сообщения: 8,004
Версия Delphi: 7, XE3, 10.2
Репутация: 49089
По умолчанию

прблема на линиях 44-53.
Как я понимаю, теюе надо сначала проверить ВСЕ отрезки на пересечение, а только потом принять решение о том, добавлять ли новый отрезок в список (массив) или нет. А тут у тебя полный бардак.
Я бы написал как-то так:
Код:
var
  b : Boolean;
...
  b := false;
  for i := Low(arect1) to High(arect1) do
  begin
    b := CollisionLineFromTRECT(arec1[i], buf_Rect);
    if b then break;
  end;
  if not b then
  begin
      Inc(k);
      SetLength(arec1, k);
      arec1[k - 1] := buf_Rect;
  end;
Т.е. вводим флаг. Инициализируем его значением false.
Теперь бежим по всем сохраненным отрезкам и проверяем их на пересечение с текущим сгенерированным. Если пересечение есть, то флаг становаится true и мы прерываем цикл проверки.
После проверки, если флаг не поменял своего значения (т.е. он равен false), то добавляем новый отрезок в массив.
Ответить с цитированием
  #3  
Старый 13.06.2022, 10:53
TennisAdept TennisAdept вне форума
Прохожий
 
Регистрация: 10.06.2021
Сообщения: 2
Версия Delphi: Delphi 7
Репутация: 10
По умолчанию

Спасибо за ответ конечно, но бардак не полный, разобрался. Проблема действительно на линии 46 - (не только же нулевой элемент надо проверять, а ВСЕ), и на 39-40 (надо приклеивать начало нового отрезка к концу последнего в массиве, а не k-го).
Цитата:
сначала проверить ВСЕ отрезки на пересечение
вроде так и делаю
Цитата:
Т.е. вводим флаг
А флаг вводить зачем, если результат CollisionLineFromTRECT и так логический?
И да, забыл в окне с кодом указать, что тип TArrayOfRects - пользовательский, но это мелочи и кстати так делать, имхо, не обязательно.
Итак, работающий код и исходники выкладываю, вдруг кому-то полезно.

Но допускаю, что весь алгоритм можно прописать изящнее и профессиональнее, (понятнее, лаконичнее, экономнее по памяти и т.д.) также, скажем,тестер сразу увидит тонкие места,поэтому если кто-то захочет внести свою лепту в оптимизацию - буду рад. Применение данный код призван найти в работе с большими битмапами размером в 4К и больше.

Код:
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;
Изображения
Тип файла: png Снимок12-13.png (13.6 Кбайт, 2 просмотров)
Вложения
Тип файла: zip ForNonCrossedSection.zip (7.4 Кбайт, 1 просмотров)
Тип файла: zip Project1.zip (216.4 Кбайт, 0 просмотров)
Ответить с цитированием
  #4  
Старый 13.06.2022, 18:37
lmikle lmikle вне форума
Модератор
 
Регистрация: 17.04.2008
Сообщения: 8,004
Версия Delphi: 7, XE3, 10.2
Репутация: 49089
По умолчанию

Цитата:
Сообщение от TennisAdept
А флаг вводить зачем, если результат CollisionLineFromTRECT и так логический?

Флаг для того, что бы отделить логику принятия решения от кода проверки.
Флаг инициализируется значением, которое говорит, что коллизий нет.

Далее в цикле идет проверка на коллизии и на каждой итерации значение флага обновляется. Если коллизия найдена, то происходит прерывание цикла проверки.

Теперь имеем 2 ситуации при проверке - есть коллизии или их нет.
Как после цикла проверки узнать, были ли коллизии или нет? Вот тут мы снова возаращаемся к флагу.

В принципе, твоя реализация тоже будет работать. Но она более запутанная, хотя и делает все тоже самое. Т.О. путем введения всего лишь одного флага мы делаем код более читабельным, что помогает в отладке.
Например, мне потребовалось около 5 минут что бы понять, что делает твой код и проанализировать где там может быть проблема. В моей редакции, надеюсь, тебе потребовалось меньше минуты.
Ответить с цитированием
Ответ


Delphi Sources

Опции темы Поиск в этой теме
Поиск в этой теме:

Расширенный поиск
Опции просмотра

Ваши права в разделе
Вы не можете создавать темы
Вы не можете отвечать на сообщения
Вы не можете прикреплять файлы
Вы не можете редактировать сообщения

BB-коды Вкл.
Смайлы Вкл.
[IMG] код Вкл.
HTML код Выкл.
Быстрый переход


Часовой пояс GMT +3, время: 20:30.


 

Сайт

Форум

FAQ

RSS лента

Прочее

 

Copyright © Форум "Delphi Sources" by BrokenByte Software, 2004-2023

ВКонтакте   Facebook   Twitter