На главную Наши проекты:
Журнал   ·   Discuz!ML   ·   Wiki   ·   DRKB   ·   Помощь проекту
ПРАВИЛА FAQ Помощь Участники Календарь Избранное RSS

Дорогие друзья! Поздравляем вас с Новым 2025 годом!

Всем удачи, успеха и благополучия!

msm.ru
! ПРАВИЛА РАЗДЕЛА · FAQ раздела Delphi · Книги по Delphi
Пожалуйста, выделяйте текст программы тегом [сode=pas] ... [/сode]. Для этого используйте кнопку [code=pas] в форме ответа или комбобокс, если нужно вставить код на языке, отличном от Дельфи/Паскаля.
Следующие вопросы задаются очень часто, подробно разобраны в FAQ и, поэтому, будут безжалостно удаляться:
1. Преобразовать переменную типа String в тип PChar (PAnsiChar)
2. Как "свернуть" программу в трей.
3. Как "скрыться" от Ctrl + Alt + Del (заблокировать их и т.п.)
4. Как прочитать список файлов, поддиректорий в директории?
5. Как запустить программу/файл?
... (продолжение следует) ...

Вопросы, подробно описанные во встроенной справочной системе Delphi, не несут полезной тематической нагрузки, поэтому будут удаляться.
Запрещается создавать темы с просьбой выполнить какую-то работу за автора темы. Форум является средством общения и общего поиска решения. Вашу работу за Вас никто выполнять не будет.


Внимание
Попытки открытия обсуждений реализации вредоносного ПО, включая различные интерпретации спам-ботов, наказывается предупреждением на 30 дней.
Повторная попытка - 60 дней. Последующие попытки бан.
Мат в разделе - бан на три месяца...
Модераторы: jack128, D[u]fa, Shaggy, Rouse_
  
> Массив непересекающихся отрезков
    Доброго времени суток, эксперты.

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

    Спасибо

    ExpandedWrap disabled
      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 (7,4 Кбайт, скачиваний: 3)
      Цитата Psychologist @
      Но не получается ни группа разрозненных отрезков, ни одна ломаная без самопересечений - что я делаю не так?

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

      А, во-вторых, у тебя с индексом k путаница.
        спасибо, разобрался еще вчера ночью:

        ExpandedWrap disabled
          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. Исправил, теперь получаются непересекающиеся отрезки либо несамопересекающаяся ломаная, что мне и нужно было. спасибо за ответ
        0 пользователей читают эту тему (0 гостей и 0 скрытых пользователей)
        0 пользователей:


        Рейтинг@Mail.ru
        [ Script execution time: 0,0290 ]   [ 17 queries used ]   [ Generated: 22.01.25, 01:45 GMT ]