[TennisAdept]

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

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

Спасибо

Код:

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64

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;

[lmikle]

прблема на линиях 44-53.
Как я понимаю, теюе надо сначала проверить ВСЕ отрезки на пересечение, а только потом принять решение о том, добавлять ли новый отрезок в список (массив) или нет. А тут у тебя полный бардак.
Я бы написал как-то так:

Код:

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15

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), то добавляем новый отрезок в массив.

[TennisAdept]

Спасибо за ответ конечно, но бардак не полный, разобрался. Проблема действительно на линии 46 - (не только же нулевой элемент надо проверять, а ВСЕ), и на 39-40 (надо приклеивать начало нового отрезка к концу последнего в массиве, а не k-го).

сначала проверить ВСЕ отрезки на пересечение

вроде так и делаю

Т.е. вводим флаг

А флаг вводить зачем, если результат CollisionLineFromTRECT и так логический?
И да, забыл в окне с кодом указать, что тип TArrayOfRects - пользовательский, но это мелочи и кстати так делать, имхо, не обязательно.
Итак, работающий код и исходники выкладываю, вдруг кому-то полезно.

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

Код:

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44

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;

[lmikle]

Сообщение от TennisAdept

А флаг вводить зачем, если результат CollisionLineFromTRECT и так логический?

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

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

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

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