Координаты пикселей.

[Vova777]

Как получить координаты всех пикселей прямоугольника или линии выведенной Canvas-ом на компоненте TImage ?

[A-IX-2]

Как вариант - искать цвет пикселя, если совпадает с заданным, выводить его координаты. Но это только если такой цвет нигде, кроме прямоугольника, больше не используется в TImage.

[Vova777]

Сообщение от A-IX-2

Как вариант - искать цвет пикселя, если совпадает с заданным, выводить его координаты. Но это только если такой цвет нигде, кроме прямоугольника, больше не используется в TImage.

1) Нужно получить координаты каждого пикселя прямоугольника.
2) Такой цвет встречается на TImage очень часто.

[A-IX-2]

Попробуйте от этого плясать:

Var x1,y1,x2,y2: integer;
rectangle1: TRect;
procedure TForm1.FormCreate(Sender: TObject);
begin
  x1:=10; y1:=100; x2:=200; y2:=10;
  rectangle1:=Rect(x1,y1,x2,y2);
  Image1.Canvas.Rectangle(rectangle1);
end;

procedure TForm1.Button1Click(Sender: TObject);
var i,x: integer;
begin
  x:=x1;
  //координаты верхней стороны
  For i:=x1 to x2 do
  begin
    ListBox1.Items.Add(FormatFloat('0.',x)+','+FormatFloat('0.',Rectangle1.Top));
    x:=x+1;
  end;
  x1:=10; y1:=100; x2:=200; y2:=10;
  //координаты нижней стороны
  x:=x1;
  For i:=x1 to x2 do
  begin
    ListBox1.Items.Add(FormatFloat('0.',x)+','+FormatFloat('0.',Rectangle1.Bottom));
    x:=x+1;
  end;
  x1:=10; y1:=100; x2:=200; y2:=10;
  //координаты левой стороны
  x:=y1;
  For i:=y2 to y1 do
  begin
    ListBox1.Items.Add(FormatFloat('0.',Rectangle1.Left)+','+FormatFloat('0.',x));
    x:=x-1;
  end;
  x1:=10; y1:=100; x2:=200; y2:=10;
  //координаты правой стороны
  x:=y1;
  For i:=y2 to y1 do
  begin
    ListBox1.Items.Add(FormatFloat('0.',Rectangle1.Right)+','+FormatFloat('0.',x));
    x:=x-1;
  end;
end;

[Gonzo]

Если Вы сами рисуете прямоугольник - зачем его потом искать? - координаты же уже известны при рисовании. Или я что-то не понял?
---
Если требуется искать линии и/или прямоугольники на загруженном в TImage изображении, то имеет смысл проделать следующее:
- бинаризировать изображение:
суммируем компоненты цвета (если в RGB) каждого пикселя и сравниваем с пороговым значением. Если больше порога - закрашиваем clBlack, иначе clWhite.
Порог можно выбирать динамически по среднему цвету соседних пикселей;
- затем можно пройтись каким-нибудь фильтром (напр. Собеля):
суть в том, что для каждого пикселя анализируется яркость его соседей и делается вывод - является точка граничной или нет.
Можно граничные точки закрасить напр. clRed;
- теперь находим линии и прямоугольники:
тут можно воспользоваться алгоритмом Хаафа - от точки A до точки B считаем кол-во закрашенных точек с учетом разрывов и перегибов. Если набирается N закрашенных точек - делаем вывод: линия найдена.
Разумно будет написать функцию для поиска линии и написать функцию для поиска прямоугольников, использующую первую функцию.
ИМХО - как-то так, хотя можно предложить и другие реализации.
Имейте в виду, что попиксельные операции могут занять продолжительное время:
- используйте ScanLine и нужные структуры в зависимости от PixelFormat;
- можно обрабатывать изображение в несколько потоков - каждый свой участок.
Если нужно - помогу кодом.

[Vova777]

Искать координаты каждого пикселя нужно затем, чтобы потом заполнить таблицу TStringGrid. Объясняю, что да как:
На форме есть TImage размером 200х200 пкс. Еще есть таблица TStringGrid с количеством строк и столбцов соответствующим размерам TImage (200х200). На TImage выводится Polygon (по-сути, это прямоугольник под углом 45 гр. относительно его центра). Задача заполнить таблицу так, что если пиксель с координатами 100х100 принадлежит полигону, то в таблице в строку 100 и столбец 100 нужно занести число 1. В общем, представить все пиксели прямоугольника в таблицу.
Зачем это нужно? Это нужно для того, чтобы при движении мышью над пикселями полигона пользователь увидел определенное пояснение, т.е. размеры прямоугольника. Почему не сделать проще? Да затем, что на самом деле TImage имеет размеры 3100х1500 пкс, и подобных прямоугольников может быть довольно много и под разными углами выведенных (еще могут быть квадраты, овалы, круги, треугольники, шестигранники, ромбы и т.п.). А если определенный тип прямоугольников или другой фигуры (вернее, их пикселей) обозначу в таблице например 1, а другой тип например 2 и т.п., то я могу с легкостью их по-пиксельно идентифицировать, получив значение из таблицы (если "1" то прямоугольник такой-то и т.п.), и это все на событии OnMouseMove.

[Vova777]

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

Если Вы сами рисуете прямоугольник - зачем его потом искать? - координаты же уже известны при рисовании. Или я что-то не понял?
---
Если требуется искать линии и/или прямоугольники на загруженном в TImage изображении, то имеет смысл проделать следующее:
- бинаризировать изображение:
суммируем компоненты цвета (если в RGB) каждого пикселя и сравниваем с пороговым значением. Если больше порога - закрашиваем clBlack, иначе clWhite.
Порог можно выбирать динамически по среднему цвету соседних пикселей;
- затем можно пройтись каким-нибудь фильтром (напр. Собеля):
суть в том, что для каждого пикселя анализируется яркость его соседей и делается вывод - является точка граничной или нет.
Можно граничные точки закрасить напр. clRed;
- теперь находим линии и прямоугольники:
тут можно воспользоваться алгоритмом Хаафа - от точки A до точки B считаем кол-во закрашенных точек с учетом разрывов и перегибов. Если набирается N закрашенных точек - делаем вывод: линия найдена.
Разумно будет написать функцию для поиска линии и написать функцию для поиска прямоугольников, использующую первую функцию.
ИМХО - как-то так, хотя можно предложить и другие реализации.
Имейте в виду, что попиксельные операции могут занять продолжительное время:
- используйте ScanLine и нужные структуры в зависимости от PixelFormat;
- можно обрабатывать изображение в несколько потоков - каждый свой участок.
Если нужно - помогу кодом.

Прочтите мой последний пост с пояснением, к тому, чего нужно добиться. Там мне нужно будет использовать вышеприведенные алгоритмы или можно как-то иначе? По-поводу помощи кодом буду очень признателен.

[Gonzo]

Фигуры, которые нужно идентифицировать рисуете Вы? или Вы загружаете изображение с уже нарисованными фигурами?

[Vova777]

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

Фигуры, которые нужно идентифицировать рисуете Вы? или Вы загружаете изображение с уже нарисованными фигурами?

Рисую я. Если бы это были простые прямоугольники или квадраты, то я бы даже тему на создавал. Вся проблема в том, что используется алгоритм поворота изображения (в данном случае, это и есть тот прямоугольник, который мне нужно по-пиксельно идентифицировать) или Матрица поворота. Т.е. я уже не могу просто взять и посчитать пиксели как в обычной фигуре.

[Gonzo]

Приведите пример размеров, которые необходимо выводить в подсказке.
И как быть в Вашем случае, если в каком-то пикселе фигура 1-ого типа и фигура 2-ого типа пересекаются?
Мне кажется тут лучше хранить массив полигонов, а затем проверять входит ли точка в какой-либо полигон.

type TPolygon = array of TPoint;
var Polygons: array of TPolygon; //массив полигонов

function InsidePolygon(aX, aY: Integer; Points: TPolygon): Boolean;
  { проверяет, попадает ли указанная точка в полигон }
  { если попадает, вернет True, иначе - False }
var
  I: Integer;
  StartDirection, Direction, NewDirection: Boolean;
  Count, Start, X1, X2, XC, Y, Y1, Y2: Integer;
begin
  Result := False;
  Count := Length(Points);
  if Count < 2 then
    Exit;
  // пропускаем стартовые горизонтальные линии
  Start := 0;
  X1 := Points[0].X;
  X2 := X1;
  Y := Points[0].Y;
  while (Start <= Count - 2) and (Y = Points[Start + 1].Y) do
  begin
    Inc(Start);
    if Points[Start].X < X1 then
      X1 := Points[Start].X;
    if Points[Start].X > X2 then
      X2 := Points[Start].X;
  end;
  if (Start > 0) and (Y = aY) and (X1 <= aX) then
  begin
    Result := True;
    // если наша точка на гроизонтальной линии, сразу выходим
    if X2 >= aX then
      Exit;
  end;
  // если ничего кроме этих линий и не было, смотреть больше нечего
  if Start = Count - 1 then
    Exit;
  Direction := (Points[Start].Y < Points[Start + 1].Y);
  StartDirection := Direction;
  // первая линия после горизонтальной
  X1 := Points[Start].X;
  Y1 := Points[Start].Y;
  X2 := Points[Start + 1].X;
  Y2 := Points[Start + 1].Y;
  if aY = Y1 then
  begin
    // на уровне первой точки
    if Start = 0 then
    begin
      if aX = X1 then
      begin
        Result := True;
        Exit;
      end;
      if aX > X1 then
        Result := not Result;
    end;
  end
  else if Direction and (aY > Y1) and (aY <= Y2) or
    not Direction and (aY >= Y2) and (aY < Y1) then
  begin
    XC := X1 + Int64(X2 - X1) * Int64(aY - Y1) div (Y2 - Y1);
    if aX = XC then
    begin
      Result := True;
      Exit;
    end;
    if aX > XC then
      Result := not Result;
  end;
  // остальные линии до предпоследней
  for I := Start + 1 to Count - 1 do
  begin
    X1 := Points[I].X;
    Y1 := Points[I].Y;
    X2 := Points[(I + 1) mod Count].X;
    Y2 := Points[(I + 1) mod Count].Y;
    if Y1 = Y2 then
    begin
      // горизонтальные просто проверяем на границу
      if aY = Y1 then
      begin
        if (X2 >= X1) and (aX >= X1) and (aX <= X2) or
          (X2 < X1) and (aX >= X2) and (aX <= X1) then
        begin
          Result := True;
          Exit;
        end;
        if (aX > X1) and (I = Count - 1) and (StartDirection = NewDirection) then
          Result := not Result;
      end;
    end
    else
    begin
      NewDirection := (Y1 < Y2);
      if aY = Y1 then
      begin
        // на уровне первой точки
        if Direction <> NewDirection then
        begin
          if aX = X1 then
          begin
            Result := True;
            Exit;
          end;
          if aX > X1 then
            Result := not Result;
        end;
      end
      else if aY = Y2 then
      begin
        // на уровне последней точки
        if (I < Count - 1) or (StartDirection <> NewDirection) then
        begin
          if aX = X2 then
          begin
            Result := True;
            Exit;
          end;
          if aX > X2 then
            Result := not Result;
        end;
      end
      else if NewDirection and (aY > Y1) and (aY < Y2) or
        not NewDirection and (aY > Y2) and (aY < Y1) then
      begin
        XC := X1 + Int64(X2 - X1) * Int64(aY - Y1) div (Y2 - Y1);
        if aX = XC then
        begin
          Result := True;
          Exit;
        end;
        if aX > XC then
          Result := not Result;
      end;
      Direction := NewDirection;
    end;
  end;
end;