Заливки бывают разные...

[pronto]

Доброго времени суток, уважаемые форумчане!
В прикладных целях понадобился алгоритм обхода группы пикселей с заданным цветом (черным). Только после его написания я понял, что мне нужно было искать алгоритм заливки области.

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

' мой 4-х связный алгоритм обхода-заливки
' Не использует рекурсию, дает точное значение точек в области
' и запоминает их координаты – это сделано специально
ub = 4095
ReDim Group(ub) 'ub – upper bound
Group(gi).x = x: Group(gi).y = y

Do
   cx = Group(gi).x: cy = Group(gi).y
   SetPixel pdc, cx, cy, vbRed

   For i = 0 To zi ' перебор связей
      Point.x = cx + dz(i).dx
      Point.y = cy + dz(i).dy

      fp = GetPixel(pdc, Point.x, Point.y)

      If fp = 0 Then
         mb = 0

         For m = gi + 1 To si ' предотвращение повторного добавления точки
            If Point.x = Group(m).x And Point.y = Group(m).y Then mb = 1
         Next m

         If mb = 0 Then
            si = si + 1
            rdp = rdp + 1
            If rdp = 4096 Then
               ub = ub + 4096
               ReDim Preserve Group(ub) 'ub
               rdp = 0
            End If

            Group(si) = Point
         End If
      End If

   Next i

   gi = gi + 1
Loop Until gi > si

Его единственное узкое место – скорость. Поиск дал более быстрый построчный алгоритм. Он быстрее первого приблизительно в 1.5 раза.

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

' реализация на С++ Builder
void PixelFill(int x, int y)
{
   int xx = x;

   While (1)
   {
      Form1 -> Canvas -> Pixels[xx][y] = clRed;

      xx--;
      left_x = xx;

      c = Form1 -> Canvas -> Pixels[xx][y];
      if ((c == clBlack) || (c == clRed)) break;
   }

   xx = x;

   While (1)
   {
      Form1 -> Canvas -> Pixels[xx][y] = clRed;

      xx++;
      left_x = xx;

      c = Form1 -> Canvas -> Pixels[xx][y];
      if ((c == clBlack) || (c == clRed)) break;
   }

   for (int temp = left_x + 1; temp < right_x; temp++)
   {
      c = Form1 -> Canvas -> Pixels[temp][y + 1];
      if ((c! = clBlack)) PixelFill(temp, y + 1);

      c = Form1 -> Canvas -> Pixels[temp][y - 1];
      if ((c! = clBlack)) PixelFill(temp, y - 1);
   }
}

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

' перевод на VB. Доставил некоторые трудности, так как на Си я разговариваю только со словарем
Private Sub CoherentFill(ByVal x As Long, ByVal y As Long)
   Dim cx As Long, cy As Long, q As Long
   Dim lx As Long, rx As Long, tx As Long
   
   cx = x: cy = y
   
   Do
      SetPixel pdc, cx, cy, vbRed
      cx = cx - 1
     
      q = GetPixel(pdc, cx, cy)
   Loop While q = vbBlack 'Until q = vbWhite Or q = vbRed
   
   lx = cx
   cx = x
   
   Do
      SetPixel pdc, cx, cy, vbRed
      cx = cx + 1
      q = GetPixel(pdc, cx, cy)
   Loop While q = vbBlack 'Until q = vbWhite Or q = vbRed
   
   rx = cx
   tx = lx
   
   Do
      tx = tx + 1
      If GetPixel(pdc, tx, cy + 1) = vbBlack Then CoherentFillSlow tx, cy + 1
     
      If GetPixel(pdc, tx, cy - 1) = vbBlack Then CoherentFillSlow tx, cy - 1
   Loop While tx < rx
End Sub

Теперь о самом главном!
Очень хочется повысить скорость этого алгоритма (за счет избавления от рекурсии?) и заставить его выдавать точное количество точек в группе. Вот что у меня вышло.. .

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

ReDim pStack(li)
pStack(li).x = x: pStack(li).y = y

Do
   cx = pStack(li).x: cy = pStack(li).y
   li = li + 1
   
   Do
      SetPixel pdc, cx, cy, vbRed
     
      ip = ip + 1 ' счетчик точек?
      cx = cx - 1
      q = GetPixel(pdc, cx, cy)

   Loop While q = vbBlack
   
   cx = x
   lx = cx
   
   Do
      SetPixel pdc, cx, cy, vbRed
     
      ip = ip + 1 ' счетчик точек?
      cx = cx + 1
      q = GetPixel(pdc, cx, cy)
     
   Loop While q = vbBlack
   
   rx = cx '- 1

   If GetPixel(pdc, lx, cy + 1) = vbBlack Then
      si = si + 1
      ReDim Preserve pStack(si)
      pStack(si).x = lx: pStack(si).y = cy + 1
   End If
   If GetPixel(pdc, lx, cy - 1) = vbBlack Then
      si = si + 1
      ReDim Preserve pStack(si)
      pStack(si).x = lx: pStack(si).y = cy - 1
   End If

Loop Until li = si

Но что-то я делаю не так. Не хочет правильно работать. В этом и вопрос.