Название: Массив непересекающихся отрезков Отправлено: Psychologist от 12-06-2022 23:07 Доброго времени суток, эксперты.
D7. Создаю массив значений типа TRect, для хранения отрезков. Хочу получить генерацию непересекающихся отрезков. Функцию для проверки пересечения отрезков, взял, с небольшой модификацией, отсюда: https://delphisources.ru/forum/showthread.php?t=20462/ Отрезки, которые касаются или даже накладываются друг на друга, она не считает пересекающимися, что мне подходит. N задаёт длину массива и число генераций. RadioGroup1 позволяет выбрать, отдельные отрезки будут генерироваться или одна ломаная линия. Но не получается ни группа разрозненных отрезков, ни одна ломаная без самопересечений...В чём ошибка? Спасибо Код: (Delphi) 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; Название: Re: Массив непересекающихся отрезков Отправлено: Finch от 13-06-2022 15:56 В чем именно затык? У меня например сейчас нету доступа к Дельфи, чтоб проверять и дебажить.
Название: Re: Массив непересекающихся отрезков Отправлено: Psychologist от 14-06-2022 09:03 Цитата В чем именно затык? Уже решил проблему, спасибо. Допустил пару логических ошибок, вот исправленый код клика на кнопке: Код: (Delphi) 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; если кому нужно, работающие исходники прилагаю |