Показать сообщение отдельно
  #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 просмотров)
Ответить с цитированием