Вложенный цикл

[Alex2013]

Странная проблема ( решение разумеется нашел но вопросы остались )...
В процессе начальной разработки (Без малейших признаков оптимизации просто по принципу "абы начать писать" )

Написал простейший кусок кода ...

Код: Выделить всё

Image2.Picture.Clear;
Image2.Picture.Bitmap.Canvas.Brush.Color:=clWhite;
W:=Image1.Picture.Width; H:=Image1.Picture.Height;
Image2.Picture.Bitmap.SetSize(W,H);
Image2.Picture.Bitmap.Canvas.FillRect(0,0,W,H);

For Y:=0 to H-1 do begin
    For X:=0 to W-1 do begin
   C:= Image1.Picture.Bitmap.Canvas.Pixels[X,Y];
   self.Lab1.Caption:=IntToStr(c);
// тут начинается код распознавания маркера 
    if (RED(C)+Green(C)+Blue(C)) div 3 < 250 then
       Image2.Picture.Bitmap.Canvas.Pixels[X,Y]:=clBlack
       else Image2.Picture.Bitmap.Canvas.Pixels[X,Y]:=clWhite;
{==========================
и т.д. (дальше  временно закомментировал )...
=====} 
    end
   end;


...И с немалым удивлением обнаружил, что после его выполнения по выходу из обработчика нажатия кнопки программа то ли завершается, то ли виснет со сворачиванием окна ...
Лазарус 1.2.6 (Win7 32)
Одиночный цикл по Х работает нормально ...
Но во вложенном цикле любое обращение к Image2. ... Pixels[X,Y] вызывает сбои ...

НО интересно, что вообще может сбоить в таком с позволения сказать коде Это же все равно, что в калькуляторе умножать 2*2 и регулярно получать 5 !
Ps
Сделал пока через таймер вышло даже нагляднее ...

[Sharfik]

у меня работает, но для больших картинок просится beginupdate/endupdate.
Может тебе перед for вставить application.processmessages ?

[zub]

Нужен полный пример, скорее всего ошибка "гдето рядом".
Например по какой либо причине W становится равной 0 перед циклом и получаем очень долгий внутренний цикл.

[скалогрыз]

ошибки нет.
просто нужно избравится от двух вещей.
1) self.Lab1.Caption:=IntToStr(c)
это строчка потенциально заставляет форму обновлятся и перерисовыватся. Её нужно либо выкинуть, либо передвинуть за циклы. Т.к. её наличие скорее указывает на попытку отладится, нежели дать какую-нибудь полезную информацию на экран, (ибо не hex)

2) не работать с Image2.Picture.Bitmap напрямую.
Вместо этого, создать локальный Bitmap, скопировать в него содержимое из Image2.Picture.Bitmap
Проработать пиксели до чёрно-белого, и "вернуть" содержимое обратно в Image2.Picture.Bitmap.

Иначе ничего не полуичится.

Добавлено спустя 3 минуты 1 секунду:
можно ещё сделать хитрые ухищрения, вроде

Код: Выделить всё

RED(C)+Green(C)+Blue(C)) div 3 < 250


поменять на

Код: Выделить всё

RED(C)+Green(C)+Blue(C)) >= 750


Но на самом деле, на данный момент, это не самое тормозное место, как было сказано выше.

[Alex2013]

Да вы правы ...
self.Lab1.Caption:=IntToStr(c)
это уже остатки лихорадочных попыток отладки ...
Но проблемы начались еще ДО них ...
"трормоз" пока не некритичен нужно просто проверить придуманный алгоритм .
изначально было так...

Код: Выделить всё

For Y:=0 to H-1 do
    For X:=0 to W-1 do begin
       C:= Image1.Picture.Bitmap.Canvas.Pixels[X,Y];
    if (RED(C)+Green(C)+Blue(C)) div 3 < 250 then
       Image2.Picture.Bitmap.Canvas.Pixels[X,Y]:=clBlack
       else Image2.Picture.Bitmap.Canvas.Pixels[X,Y]:=clWhite;
end ; 


x,y,c,h,w ... все объявлено локальными переменными ..
Убираю "For Y:=0 to H-1 do" все работает ..
восстанавливаю
убираю { Image2.Picture.Bitmap.Canvas.Pixels[X,Y]:=clBlack
else Image2.Picture.Bitmap.Canvas.Pixels[X,Y]:=clWhite) };
Цикл пролетает нормально ...
Причем значения в полном порядке (для отладки записал все в листбокс )

Возможно вы правы и писать прямо в Image2.Picture.Bitmap "скверный тон" ..
Но опять же в пределах одной строки все ок ...
"Открыл цикл" в таймере и наглядно обработал все по строкам вообще шик и блеск !
Но почему в примитивном вложенном цикле возникает сбой не понятно ..

Есть идея, что дело в многоядернности точнее в попытке оси выполнять несколько не вполне реитерабельных вызовов одновременно ....

А вот это уже гораздо более серьезная тема для обсуждения чем пара багов ведь если это так или иначе распространяется на любой казалось бы "канонический код" то может возникать масса неуловимых "плавающих багов" ....

[resident]

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

Код: Выделить всё

procedure TForm1.Button1Click(Sender: TObject);
  var x,y,c,w,h: integer;
  begin
    Image1.Picture.Clear;

    Image1.Picture.Bitmap.LoadFromFile('F:\_Desktop\1347102303_095215_14.bmp');

    W:=Image1.Picture.Width;
    H:=Image1.Picture.Height;

    For Y:=0 to H-1 do
      For X:=0 to W-1 do
        begin
           C:= Image1.Picture.Bitmap.Canvas.Pixels[X,Y];
           if (RED(C)+Green(C)+Blue(C)) div 3 < 250
             then Image1.Picture.Bitmap.Canvas.Pixels[X,Y]:=clBlack
             else Image1.Picture.Bitmap.Canvas.Pixels[X,Y]:=clWhite;

           Application.ProcessMessages;
        end
  end;


[Alex2013]

А без Application.ProcessMessages; ?
Зы
Это получается, что в любой цикл с обращением к системным функциям (перерисовкой чего либо на форме ) нужно вставлять "отдачу тиков "( Application.ProcessMessages; ) ?

[resident]

А без Application.ProcessMessages; ?

Работает и без, только тогда не видно как меняются пиксели, скорость получения результата возрастает в сотни раз и сразу показывается ч/б картинка.

Добавлено спустя 31 минуту 31 секунду:
Alex2013 можете попробовать еще через TLazIntfImage. Результат появляется мгновенно.
з.ы. А что вы в итоге хотите сделать?

Код: Выделить всё


uses IntfGraphics;

procedure TForm1.Button1Click(Sender: TObject);
var x,y,c,w,h: integer;
    b: TBitmap;
    t: TLazIntfImage;
begin
   b := TBitmap.Create;
   try
     b.LoadFromFile('F:\_Desktop\1347102303_095215_14.bmp');

     // нет смысла показывать оригинал, все равно не успеешь увидеть
     {Image1.Picture.Clear;
     Image1.Picture.Bitmap.Assign(b);
     Application.ProcessMessages;}

     W:=b.Width;
     H:=b.Height;

     t := b.CreateIntfImage;

     For Y:=0 to H-1 do
       For X:=0 to W-1 do
         begin
            C:= FPColorToTColor(t.Colors[X,Y]);
            if (RED(C)+Green(C)+Blue(C)) div 3 < 250
              then t.Colors[X,Y]:=TColorToFPColor(clBlack)
              else t.Colors[X,Y]:=TColorToFPColor(clWhite);
         end;

     b.LoadFromIntfImage(t);

     Image1.Picture.Clear;
     Image1.Picture.Bitmap.Assign(b);
   finally
     t.Free;
     b.Free;
   end;
  end;



[Alex2013]

Это часть моих первых попыток разбрататься с идеями "дополненной реальности" конкретно часть программы для работы пока с "бумажной"( а после возможно и с виртуальной) клавиатурой ..
Пока занят тем что пытаюсь распознавать спец маркеры и по их расположению определять "рабочее поле" в котором будет находится "бумажная клавиатура " .
В общем есть идея повторить "подвиг" программистов айфона ...

[Alex2013]

Значит что Alex2013 писал(а):А без Application.ProcessMessages; ?


Работает и без, только тогда не видно как меняются пиксели, скорость получения результата возрастает в сотни раз и сразу показывается ч/б картинка.

Значит что-то локальное с железом или оси разные...
Кстати проверил с Application.ProcessMessages; все работает и у меня..
Так что спасибо !
Зы
Появился еще один интересный вопрос!

Нужен алгоритм определения прямоугольника вокруг произвольной фигуры-контура..
Для частного случая простой выпуклой фигуры можно использовать что-то вроде вот этого кода....

Код: Выделить всё

// Обработка этап 4  Поиск контуров
procedure TFm1.Button5Click(Sender: TObject);
Var X,Y, X1,Y1, X2,Y2 ,w,h,C:Integer;

  //"Правое дело !" :)
Procedure ScanRD;
Var
  Xi,Yi,XC,YC:Integer;
begin
For Yi:=X1 to H-1 do begin
  For Xi:=X1 to W-1 do begin
      C:= Image2.Picture.Bitmap.Canvas.Pixels[Xi+1,Yi];
     if C = clBlack then XC:=Xi  else break;
     Application.ProcessMessages;
  end;
    If xc > x2 then  x2:= xc;
  end;
  For Xi:=X1 to W-1 do begin
  For Yi:=Y1 to H-1 do begin
      C:= Image2.Picture.Bitmap.Canvas.Pixels[Xi,Yi+1];
     if C = clBlack then YC:=YI  else break;
     Application.ProcessMessages;
  end;
    If yc > y2 then  y2:= yc;
  end;
  Inc(X2,2);Inc(Y2,2);
end;

Label L1;
Label L2;
//*************************************************
Begin
X2:=0;
Y2:=0;
W:=Image1.Picture.Width;
H:=Image1.Picture.Height;
// Поиск первой точки
// Левый верхний край ...
X1:= -1;Y1:=0;
For Y:=0 to H-1 do
  For X:=0 to W-1 do begin
    C:= Image2.Picture.Bitmap.Canvas.Pixels[X,Y];
    if C=clBlack then begin
     Y1:=Y; Goto L1;
    end;
   Application.ProcessMessages;
  end;
L1:For X:=0 to W-1 do
    For Y:=0 to H-1 do
   begin
    C:= Image2.Picture.Bitmap.Canvas.Pixels[X,Y];
    if C=clBlack then begin
     X1:=X; Goto L2;
    end;
   Application.ProcessMessages;
  end;
L2: If x1=-1 then  exit;
//Поиск правого нижнего края
  ScanRD;
//Показ результатов поиска
Image2.Picture.Bitmap.Canvas.Pen.Color:=clGreen;     Image2.Picture.Bitmap.Canvas.Rectangle(X1,y1,X2,y2);
end;


Понятное дело, общем случае эта образина не работает, да и вообще
мало на что годится ... (Выделяет одиночный контур и то не всегда правильно )
Но понять что я хочу получить можно .
Вопрос есть ли в природе что-то готовое для таких задач

[resident]

Понятное дело, общем случае эта образина не работает, да и вообще
мало на что годится ... (Выделяет одиночный контур и то не всегда правильно )
Но понять что я хочу получить можно .
Вопрос есть ли в природе что-то готовое для таких задач

В магазинах много книг по зрению, наверняка в них есть примеры.
http://www.ozon.ru/context/detail/id/31793706/

Рассмотрены схема и программный прототип для создания другого типа естественного интерфейса – сенсорного экрана на любой поверхности.

з.ы. А контур чего вы будете искать?

[Alex2013]

За ссылку спасибо ! Посмотрю ..

з.ы. А контур чего вы будете искать?

Так уже говорил ...

Пока занят тем что пытаюсь распознавать спец маркеры и по их расположению определять "рабочее поле" в котором будет находится "бумажная клавиатура "

Маркеры и их возможное положение в пространстве

Примерный алгоритм работы
0 Делаю картинку черно белой и выкручиваю контраст в максимум
(По сути делаю однобитовой).
1 Ищу все контуры после очень сильного сглаживания (сглаживание по идее нужно чтобы лишние детали слились )

2 По одному привожу их (беря из исходного изображения) к масштабу шаблона маркера ...
3 Кручу верчу и накладываю на шаблон с логической операцией NOT или ХОR
(нужно погонять проверить ) Считаю оставшиеся пиксели ...
4 Если их достаточно мало считаю фигуру распознанной ..
5 Запоминаю углы поворота и начинаю поиск второй фигуры ...
6 По взаимному расположению ограничителей определяю расположение рабочего поля в пространстве.

P.s.
Сам пока обнаружил только
Преобразование Хафа (Hough Transform)...
но думаю проще будет реализовывать обход по краю контура ...

[resident]

Ищу все контуры

А может их системы работают намного проще?
Ведь идет точная привязка геометрии - распечатай листок и положи точно по инструкции, т.е. уже изначально известно, что в такой-то области картинки "клавиша А" и т.д. Ну т.е. вместо распечатанного листка подсунуть просто разлинованный лист. Прога айфона будет работать?

Лист может быть с чем угодно, главное чтобы был НЕоднородный. Хоть миллиметровка.

Тогда прога должна просто увидеть где эта неоднородность отсутствует, там стало быть и палец (он одного цвета примерно). А дальше просто мы уже изначально знаем, что там должна быть "клавиша А". Проверить, будет ли работать прога айфона, если вместо пальца подводить к бумажной клавиатуре разлинованный листик в виде пальца?

[Alex2013]

Возможно ты прав ...
Но есть идея наработать задел на будущее ...
Кстати на смарте у меня есть утилита для сканирования QR кодов в любом (хоть вверх тормашками и под острым гулом ) положении в радиусе нескольких метров ... Так что ничего невозможного я сделать не пытаюсь ...
Уже написал простерший датчик движения (Так что с отслеживаем факта нажатия думаю проблем не будет нужно только вычислить вектор и определить что именно закрыто на его конце )
Еще пытался сделать суперзум (с динамической обработкой видео потока )...

[Alex2013]

Кстати способ определения границ замкнутого контура все-же нашел ...

Может кому-то тут пригодится...

Код: Выделить всё

// Обработка этап 4  Поиск контуров
procedure TFm1.Button5Click(Sender: TObject);
Var X,Y,w,h,C:Integer;
  // Поиск границ спрайта
// так же может применятся как метод заливки контуров заданным цветом . 
function ScanOBJ(const image:tBitmap;x,y:integer):trect;
const    delta: array[1 .. 8] of record dx, dy: integer;
end =    (  (dx:0; dy:1), (dx:1; dy:0),
                (dx:0; dy:-1),(dx:-1; dy:0),
                (dx:1; dy:1), (dx:1; dy:-1),
                (dx:-1; dy:1),   (dx:-1; dy:-1)    );
var
tempr:trect;
i: integer;
begin
with result do
begin
Left := x; Top := y;
Right := x; Bottom := y;
end;
image.Canvas.Pixels[x, y] := clRed;
//Application.ProcessMessages;
for i := 1 to 8 do
begin
if image.Canvas.Pixels[x+delta[i].dx,y+delta[i].dy] = clBlack then
begin
  tempr := ScanOBJ(image, x+delta[i].dx,y+delta[i].dy);
  if tempr.Left < result.left then result.Left := tempr.Left;
  if tempr.right > result.right then result.right := tempr.right;
  if tempr.top < result.top then result.top := tempr.top;
  if tempr.bottom > result.bottom then result.bottom := tempr.bottom;
end;
end;
end;
Label L1;
Var
R:TRect;
  begin
W:=Image1.Picture.Width;
H:=Image1.Picture.Height;
For X:=0 to W-1 do
   For Y:=0 to H-1 do
   begin
    C:= Image2.Picture.Bitmap.Canvas.Pixels[X,Y];
    if C=clBlack then begin
     R:=ScanOBJ(Image2.Picture.Bitmap,x,y );
     Application.ProcessMessages;
      Goto L1;
    end;
   Application.ProcessMessages;
  end;
L1:
Lab1.Caption:= format('X:%d, Y:%d, X1:%d, Y1:%d',
  [r.left, r.Top, r.Right, r.Bottom] );
  Image1.Picture.Bitmap.Canvas.Pen.Color:=clGreen;
  Image1.Picture.Bitmap.Canvas.Rectangle(r);
end;


Кое что нужно "допилить напильником " но в целом метод рабочий ...
Жаль чуть медленный ...