VB.NET中使用种子填充算法实现给图片着色的例子

某人最近在使用C#写一个类似Windows的画图工具，在填色的部分卡住了。劳资要他使用种子填充算法着色（不要调用Windows提供的API，否则还锻炼个毛线），现在我把这个功能实现了，程序的效率很高。现在在这里大概写一下实现方法。

程序是用VB.NET写的，C#写法类似（而且还不需要使用Marshal类访问非托管资源，更加方便）。程序的运行结果如下：

　种子填充算法说白了就是宽度优先搜索算法（BFS），如果你不知道这是什么东西，那说明你数据结构根本就没有学，请自行补充相应的知识。

　　第一步：实现“铅笔”工具

我们定义如下的全局变量（窗体类的私有成员），作用是啥一看名字就知道：

复制代码 代码如下:

Private Enum DrawStyle

    Drawing = 0

    Fill = 1

    DrawDragging = 2

End Enum

Private _fillColor() As Color = {Color.Blue, Color.Green, Color.Red, Color.LightGray, Color.LightPink, Color.LightSkyBlue, _

                                 Color.GreenYellow, Color.Gold, Color.LightSeaGreen}

Private _drawStyle As DrawStyle = DrawStyle.Drawing

Private _imgMain As Bitmap

Private _g As Graphics

Private _lastPosition As Point

Private _drawingPen As Pen

　这个程序中填充的颜色是随机决定的（都懒得做一个选颜色的功能了），可以填充的颜色在_fillColor数组中。_drawStyle定义当前的绘图模式（Drawing表示使用铅笔工具，但未按下，Fill表示准备填充，DrawDragging表示鼠标正按下并拖拽）。

　　_imgMain是绘制的图片，_g是创建在这个Bitmap上的Graphics对象。

　　需要注意的是，Drawing和Drawing2D类不提供画点的方法，我们需要通过画直线或画矩形来模拟。至于_lastPosition的作用，由于鼠标拖拽过程中，如果速度过快，那么MouseMove事件中的坐标点（每次MouseMove事件被触发）并不是连续的，所以我们需要在当前点和上一次的鼠标位置之间画一条直线，否则画出来的线是间断的。

　　MouseDown、MouseMove和MouseUp实现铅笔工具的基本功能，代码如下：

复制代码 代码如下:

Private Sub PictureBox1_MouseDown(sender As Object, e As MouseEventArgs) Handles PictureBox1.MouseDown

    If CheckBox1.Checked Then _drawStyle = DrawStyle.Fill Else _drawStyle = DrawStyle.Drawing

    If _drawStyle = DrawStyle.Fill Then

        Call FillRegion(e.Location, _fillColor(New Random().Next(_fillColor.Count)))

    Else

        _drawStyle = DrawStyle.DrawDragging

        _lastPosition = e.Location

    End If

End Sub

Private Sub PictureBox1_MouseMove(sender As Object, e As MouseEventArgs) Handles PictureBox1.MouseMove

    If _drawStyle = DrawStyle.DrawDragging Then

        _g.DrawLine(_drawingPen, _lastPosition, e.Location)

        _lastPosition = e.Location

        PictureBox1.Image = _imgMain

    End If

End Sub

Private Sub PictureBox1_MouseUp(sender As Object, e As MouseEventArgs) Handles PictureBox1.MouseUp

    _drawStyle = DrawStyle.Drawing

End Sub

　　二、正题——种子填充算法的实现

　　上面说了一堆废话，现在终于可以开始实现填充的算法了。

　　当用户点击图片中某一个点后，需要填充与这个点相邻的、颜色相同的其他点。为什么要叫“种子填充”呢？大概是这样：你在点中的那个点中播下一颗种子，它开花结果（颜色变成目标颜色），然后它又播种出新的种子（与它上下左右相邻且颜色等于原来颜色的点）；新种子再开花结果（变颜色），播种新种子…… 如此往复，直到没有地方播种了为止，算法结束。

　　按照BFS通常的实现方式，可以使用循环队列作为数据结构。对于BFS算法来说，需要的存储空间较大，具体需要多少还真不好估算。这里给大家一个参考，我的这个程序图片框大小是832*450，大概是37万像素，循环队列的容量设置为1600可以满足需求（全部着色）。如果你的图片框比较大，可以先取一个较大的数值（比如8000），再逐渐缩小，反复尝试。

　　实现这个循环队列直接定义成一个一维数组就可以了，没有必要使用ConcurrentQueue类，否则性能会下降，也没有这个必要。

　　首先，由于要向四个方向填充，为了避免类似的代码反复写导致程序丑陋无比，我们可以定义一个fill_direction数组：

复制代码 代码如下:

Dim fill_direction() As Point = {New Point(-1, 0), New Point(1, 0), New Point(0, -1), New Point(0, 1)}

　这样，使用一个For循环就可以完成四个方向的操作了。

　　按照首先说的思路，程序的实现就很简单了：首先将点击的那个点入队，记录这个点的颜色。然后使用一个循环，取出队首元素，并向四个方向撒种子（颜色相同，且没有越出图片框边界），将每一个种子的颜色改变成目标颜色并入队。如此往复直到队列为空为止。代码如下：

复制代码 代码如下:

Private Sub FillRegion2(sourcePoint As Point, destinationColor As Color)

    Dim new_bitmap As Bitmap = DirectCast(PictureBox1.Image, Bitmap)

    Dim source_color As Color = new_bitmap.GetPixel(sourcePoint.X, sourcePoint.Y)

    Dim MIN_X As Integer = 0, MIN_Y As Integer = 0

    Dim MAX_X As Integer = PictureBox1.Width - 1, MAX_Y As Integer = Pi开发者_开发入门ctureBox1.Height - 1

    Dim fill_queue(MAX_FILL_QUEUE) As Point

    Dim fill_direction() As Point = {New Point(-1, 0), New Point(1, 0), New Point(0, -1), New Point(0, 1)}

    Dim queue_head As Integer = 0

    Dim queue_tail As Integer = 1

    fill_queue(queue_tail) = sour编程客栈cePoint

    Do While queue_head <> queue_tail

        queue_head = (queue_head + 1) Mod MAX_FILL_QUEUE

        Dim current_point As Point = fill_queue(queue_head)

        For i As Integer = 0 To 3

            Dim new_point_x As Integer = current_point.X + fill_direction(i).X

            Dim new_point_y As Integer = current_point.Y + fill_direction(i).Y

            If new_point_x < MIN_X OrElse new_point_y < MIN_Y OrElse new_point_x > MAX_X OrElse new_point_y > MAX_Y Then Continue For

            If new_bitmap.GetPixel(new_point_x, new_point_y) = source_color Then

       &nbshttp://www.devze.comp;        new_bitmap.SetPixel(new_point_x, new_point_y, destinationColor)

                queue_tail = (queue_tail + 1) Mod MAX_FILL_QUEUE

                fill_queue(queue_tail) = New Point(new_point_x, new_point_y)

            End If

        Next

    Loop

    PictureBox1.Image = new_bitmap

End Sub

　可能会有一个问题，就是第一个点在入队前应该要先改成目标颜色，但我这里没有改。效果其实是一样的，因为它旁边的点在撒种子的时候发现这个点颜色没变，还是会将它入队（注意：如果只有一个点需要填充，即起始点没有相邻的点，那么会导致这个点不被填充成目标颜色，请自行改进算法）。我们在这里忽略这个小问题。

　　运行程序，可以发现已经可以实现填充的功能了。

备注：如果目标颜色和起始点的颜色相同，且起始点有相邻的、相同颜色的点，那么会导致相同的点反复入队，最终导致队列溢出。此时队首指针等于队尾指针，程序会认为队列为空而终止填充，因此最终结果没有变化（如果不是采用循环队列，会导致程序死循环）。为了避免这种情况，应该在进行填充前判断目标颜色是否和原点颜色相同，相同时直接结束。在这里我没有进行这样的判断。

三、提升效率

　在运行程序时发现了一个问题，就是如果填色区域过大（比如直接填充整个图片框），程序会很慢，大概需要2秒左右才能填充完。产生这个问题的主要原因是GetPixel和SetPixel的性能不高，每次调用这两个方法时都会做很多额外的操作，在我以前使用汇编语言调用DOS中断画点时就有这个问题。

　　为此，M$提供了LockBits和UnlockBits方法。LockBits方法可以将图片锁定到内存中，以便通过访问内存直接对这些数据进行修改。在C#中我们可以直接使用指针访问这片数据，但对于VB是不行的，因为VB不允许使用指针，我们可以借助System.Runtime.InteropServices.Marshal类达到直接访问内存的功能。

　　关于LockBits的详细介绍可以参考这篇日志：http://www.bobpowell.net/lockingbits.htm

　　nmgylAM其中很重要的一点就是要搞清楚如何计算图片上某一点的内存地址。

如这张图所示（图片来自那篇博文），坐标为(X,Y)的点在内存中的地址就是Scan0 + (Y * Stride) + X * k。k与图片中每个点占用的字节有关，我们这里使用的是32位ARPG，每个像素占4个字节，因此k就是4。另外注意Stride并不一定是n*k（n表示每行存n个像素），因为末尾可能有多余的位使数组对齐（与处理机的字长匹配）。无论如何，我们可以通过BitmapData对象的Stride属性得到。

　　由于一个ARGB值是4个字节，所以我们需要调用Marshal类的ReadInt32和WriteInt32方法对每个像素点的颜色进行读取和写入。我们要操作的是颜色的ARGB值而不是Color对象。

　　那么把上面的代码稍加改造，就可以写出如下程序：

复制代码 代码如下:

Private Sub FillRegion(sourcePoint As Point, destinationColor As Color)

    Dim new_bitmap As Bitmap = DirectCast(PictureBox1.Image, Bitmap)

    Dim source_color_int As Integer = new_bitmap.GetPixel(sourcePoint.X, sourceP编程客栈oint.Y).ToArgb

    Dim bitmap_data As BitmapData = new_bitmap.LockBits(New Rectangle(0, 0, PictureBox1.Width, PictureBox1.Height), _

                                                        Imaging.ImageLockMode.ReadWrite, new_bitmap.PixelFormat)

    Dim stride As Integer = Math.Abs(bitmap_data.Stride)

    Dim scan0 As IntPtr = bitmap_data.Scan0

    Dim bytes As Integer = stride * new_bitmap.Height

    Dim MIN_X As Integer = 1, MIN_Y As Integer = 1

    Dim MAX_X As Integer = PictureBox1.Width - 1, MAX_Y As Integer = PictureBox1.Height - 1

    Dim fill_queue(MAX_FILL_QUEUE) As Point

    Dim fill_direction() As Point = {New Point(-1, 0), New Point(1, 0), New Point(0, -1), New Point(0, 1)}

    Dim destination_color_int As Integer = destinationColor.ToArgb

    Dim queue_head As Integer = 0

    Dim queue_tail As Integer = 1

    fill_queue(queue_tail) = sourcePoint

    Do While queue_head <> queue_tail

        queue_head = (queue_head + 1) Mod MAX_FILL_QUEUE

        Dim current_point As Point = fill_queue(queue_head)

        For i As Integer = 0 To 3

            Dim new_point_x As Integer = current_point.X + fill_direction(i).X

            Dim new_point_y As Integer = current_point.Y + fill_direction(i).Y

            If new_point_x < MIN_X OrElse new_point_y < MIN_Y OrElse new_point_x > MAX_X OrElse new_point_y > MAX_Y Then Continue For

            Dim offset As Integer = (new_point_y * stride) + new_point_x * 4

            Dim current_color_int As Integer = System.Runtime.InteropServices.Marshal.ReadInt32(scan0, offset)

            If current_color_int = source_color_int Then

                System.Runtime.InteropServices.Marshal.WriteInt32(scan0, offset, destination_color_int)

                queue_tail = (queue_tail + 1) Mod MAX_FILL_QUEUE

                fill_queue(queue_tail) = New Point(new_point_x, new_point_y)

            End If

        Next

    Loop

    new_bitmap.UnlockBits(bitmap_data)

    PictureBox1.Image = new_bitmapwww.devze.com

End Sub

　当然，如果你还有其他更好的实现方法，还请多多指教。（啊，不要告诉我使用Windows的API。。。）　　现在运行一下程序，发现效率急剧上升。我测试了一下，在我的电脑上，填充37万个像素大概只需要50~60毫秒左右，效率还是令人满意的。