VB6.0中快速实现大面积不规则区域的填充

VB6.0中快速实现大面积不规则区域的填充
--------------------------------------------------------------------------------
一、引言 
区域填充是指先将区域内的一个像素 ，一般称为种子点赋予给定的颜色和辉亮，然后将该颜色扩展到整个区域内的过程。  
二、已有的填充算法及缺点 
1．扫描线法 
扫描线法可以实现已知多边形域边界的填充，多边形域可以是凹的、凸的、还可以是带孔的。该填充方法是按扫描线的顺序，计算扫描线与待填充区域的相交区间，再用要求的颜色显示这些区间的像素，即完成填充工作。这里区间的端点通过计算扫描线与多边形边界线的交点获得。所以待填充区域的边界线必须事先知道，因此它的缺点是无法实现对未知边界的区域填充。  
2．边填充算法  
边填充的基本思想是：对于每一条扫描线和每条多边形边的交点，将该扫描线上交点右方的所有像素取补。对多边形的每条边作些处理，多边形的顺序随意。该算法适用于具有帧缓冲器的图形系统，按任意顺序处理多边形的边。处理每条边时，仅访问与该边有交的扫描线上交点右方的像素。所有的边都被处理之后，按扫描线顺序读出帧缓冲器的内容，送入显示设备。该算法的优点是简单，缺点是对于复杂图形，每一像素可能被访问多次，重要的是必须事先知道待填充多边形的边界，所以在填充未知边界的区域时不适用。  
3．递归算法  
递归算法的优点是编程实现时，语言简洁。但在VB6.0实际编程实现时，这种递归算法填充稍稍大一些的图形就会出现堆栈溢出现象，据我们的实践证明，递归算法只能连续递归深度在2090次左右，也就是说，如果待填充的图形大于二千多个像素那么堆栈溢出。下面给出八连通填充方法的VB程序实现(四连通算法同理)。  

Public Sub area(p, q As Integer)  
If ((imagepixels(0, p, q) = red1) And (imagepixels(1, p, q) = green1) And (imagepixels(2, p, q) = blue1)) Then  
imagepixels(0, p, q) = 0： imagepixels(2, p, q) = 0： imagepixels(1, p, q) = 0  
Picture1.PSet (p, q), RGB(0, 0, 0)  
Call area(p + 1, q)： Call area(p, q + 1)  
Call area(p - 1, q)： Call area(p, q - 1)  
Call area(p + 1, q + 1)： Call area(p + 1, q - 1)  
Call area(p - 1, q + 1)： Call area(p - 1, q - 1)  
Else: Exit Sub  
End If  
End Sub  

三、算法的基本思想 
本算法采用两个队列（FIFO）filled和unfilled来实现区域填充。设计步骤如下：  
1． 找出该区域内部任意一点，作为填充种子。  
2． 填充该点,并把该点存入队列filled。  
3． 按逆时针，判断该点的上、右、下、左邻像素是否在filled队列内。如果在filled，说明该相邻点已填充，若不在filled队列内，则判断该相邻点在未填充队列unfilled，如果不在则将该相邻点存入unfilled。  
4． 判断未填充队列是否为空，若不空，则从队列unfilled中取出头元素，转向第三步。若为空则表示已完成所有像素填充，结束程序。  
四、程序实现及说明 
本算法定义的队列突破了递归算法中受堆栈空间大小的限制的束缚，因为它直接占用内存空间，与堆栈大小无关。以下源程序在Window 2000环境下用VB6.0编程实现。  
建立如图所示标准窗体并画上控件-2个CommandButton控件和一个PictureBox控件,调整大小,并设置控件的属性。  
4.1 通用声明  

Dim Xx As Integer, Yy As Integer  
Dim Array1(9000, 2), Array2(9000, 2) As Integer  

4.2 采集  

Private Sub Command1_Click()  
Picture1.MousePointer = 2  
End Sub  

4.3 选取种子  

Private Sub Picture1_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)  
Xx = X '选择并记录种子点的位置  
Yy = Y  
End Sub

4.4 区域填充  

Private Sub Command2_Click()  
Dim i, j, k As Integer, BoundPoint1, BoundPoint2 As Integer  
Dim Flag As Boolean, Pixel As Long  
Dim Red, Green, Blue As Integer, Bound As Boolean  
Flag = True '初始化  
i = Xx: j = Yy: BoundPoint1 = 1  
Array1(1, 1) = i  
Array1(1, 2) = j  
'搜索边界点  
Do While BoundPoint1 > 0  
BoundPoint2 = 0  
For k = 1 To BoundPoint1  
i = Array1(k, 1)  
j = Array1(k, 2)  
'搜索右点  
Pixel& = Picture1.Point(i, j + 1)  
Call IsBound(Pixel&, Bound)  
If Not Bound Then  
BoundPoint2 = BoundPoint2 + 1  
Array2(BoundPoint2, 1) = i  
Array2(BoundPoint2, 2) = j + 1  
Picture1.PSet (i, j + 1), RGB(255, 255, 255)  
End If  
'搜索左邻点  
Pixel& = Picture1.Point(i, j - 1)  
Call IsBound(Pixel&, Bound)  
If Not Bound Then  
BoundPoint2 = BoundPoint2 + 1  
Array2(BoundPoint2, 1) = i  
Array2(BoundPoint2, 2) = j - 1  
Picture1.PSet (i, j - 1), RGB(255, 255, 255)  
End If  
'搜索上邻点  
Pixel& = Picture1.Point(i - 1, j)  
Call IsBound(Pixel&, Bound)  
If Not Bound Then  
BoundPoint2 = BoundPoint2 + 1  
Array2(BoundPoint2, 1) = i - 1  
Array2(BoundPoint2, 2) = j  
Picture1.PSet (i - 1, j), RGB(255, 255, 255)  
End If  
'搜索下邻点  
Pixel& = Picture1.Point(i + 1, j)  
Call IsBound(Pixel&, Bound)  
If Not Bound Then  
BoundPoint2 = BoundPoint2 + 1  
Array2(BoundPoint2, 1) = i + 1  
Array2(BoundPoint2, 2) = j  
Picture1.PSet (i + 1, j), RGB(255, 255, 255)  
End If  
Next k  
'数组array2 中的数据传给array1  
BoundPoint1 = BoundPoint2  
For k = 1 To BoundPoint1  
Array1(k, 1) = Array2(k, 1)  
Array1(k, 2) = Array2(k, 2)  
Next k  
Picture1.Refresh  
Loop  
End Sub  
Public Sub IsBound(P As Long, Bound As Boolean) '判断P是否为边界点  
Red = P& Mod 256  
Bound = False  
Green = ((P& And &HFF00) / 256&) Mod 256&  
Blue = (P& And &HFF0000) / 65536  
If Red = 255 And Green = 255 And Blue = 255 Then  
Bound = True  
End If  
End Sub  

五、结束语 
本算法实现了在对填充区域的形状、大小均未知的情况下，以种子点开始向四周对该区域进行“扩散式”的填充。本算法解决了传统的递归算法在填充较大区域时（本例中填充区约9800Pixels）堆栈溢出的缺点。我们的实验结果显示，本算法就填充区域大小和运算速度而言，都远远超过了传统的递归算法