Форум на Исходниках.RU https://forum.sources.ru Форум на Исходниках.RU Форум на Исходниках.RU https://forum.sources.ru/index.php?showtopic=427883&view=findpost&p=3868472 Mon, 13 Jun 2022 08:53:57 +0000 Массив непересекающихся отрезков https://forum.sources.ru/index.php?showtopic=427883&view=findpost&p=3868472
    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;


Цитата
с индексом k путаница

да. во второй ветке оператора case. Исправил, теперь получаются непересекающиеся отрезки либо несамопересекающаяся ломаная, что мне и нужно было. спасибо за ответ]]> Psychologist Delphi: Общие вопросы https://forum.sources.ru/index.php?showtopic=427883&view=findpost&p=3868471 Mon, 13 Jun 2022 08:41:48 +0000 Массив непересекающихся отрезков https://forum.sources.ru/index.php?showtopic=427883&view=findpost&p=3868471 Цитата Psychologist @
Но не получается ни группа разрозненных отрезков, ни одна ломаная без самопересечений - что я делаю не так?

Во-первых, вот здесь явно должно быть не
    if CollisionLineFromTRECT(arec1[0], buf_Rect)
а
    if CollisionLineFromTRECT(arec1[i], buf_Rect)

А, во-вторых, у тебя с индексом k путаница.]]> Писатель Delphi: Общие вопросы https://forum.sources.ru/index.php?showtopic=427883&view=findpost&p=3868457 Sun, 12 Jun 2022 21:53:10 +0000 Массив непересекающихся отрезков https://forum.sources.ru/index.php?showtopic=427883&view=findpost&p=3868457
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;

ForNonCrossedSection.zip (, : 6) ]]> Psychologist Delphi: Общие вопросы