图像处理算法

Question

在二值化图像中，如何得到面积最大的图像？这个问题本来在书上己经有很多算法，但是速度很慢。我做了一种新算法:
 1、首先将上面第一行和左边每一列的所有点的灰度全部变成255.
 2、从左上角每二行第二列的点开始，从上到下、从左到右地逐点扫描，如果当前点的灰度是255，则表示是白点，就跳过。
 3、如果是黑点，首先检查当前点正上方的点，如果是黑点，就取得它所在的区域值p(i,j-1),让当前点的区域值等于它,即让该点加入该区域。p(i,j)=p(i,j-1),该区域的面积S(p(i,j-1))=S(p(i,j-1))+1，即累加1。
4、如果当前点正上方的点是白点，则依次检查当前点左上方的点p(i-1,j-1)、左方的点p(i-1,j),左下方的点,p(i-1,j+1),方法与3相同。
5、如果这些点都是白色，则检查右上方点p(i+1,j-1)、右方的点p(i+1,j)、右下方的点p(i+1,j+1),如果都为白色，则表示该点是孤立的白点，就去掉该点。
6、否则，证明该点是新成立的一个区域起点，因此p(i,j)=1,面积S(p(i,j))=1
7、扫描结束，找出S（t）数组中最大的t值，这个区域就是我们所要的区域。
8、再逐点扫描，判断当前点的p(i,j)的值是不是等于t,如果不等于就去掉该点，最后就留下了面积最大的区域。

Answer 1

代码如下:
Dim hdc As Long
Dim i As Integer
Dim j As Integer
Dim r As Long
Dim r1 As Long
Dim r2 As Long
Dim r3 As Long
Dim r4 As Long
Dim r5 As Long
Dim r6 As Long
Dim r7 As Long
Dim r8 As LongDim p(600, 600) As Long '存放每个点所在区域的值
Dim t As Integer
Dim area(1500) As Long '存放面积tuxing = Picture1.Image
hdc = Picture1.hdc
For i = 1 To Picture1.ScaleWidth - 1
   c = RGB(255, 255, 255)
   SetPixelV hdc, i, 1, c
Next
For j = 1 To Picture1.ScaleHeight - 1
   c = RGB(255, 255, 255)
   SetPixelV hdc, 1, j, c
Next
p(1, 1) = 0For i = 2 To Picture1.ScaleWidth
   For j = 2 To Picture1.ScaleHeight
    
       c = GetPixel(hdc, i, j)
       r = Red(c)
       If r > 255 Then
          r = 255
       End If
       If r < 0 Then
          r = 0
       End If
       c = GetPixel(hdc, i, j - 1) '--上
       r1 = Red(c)
       If r1 > 255 Then
          r1 = 255
       End If
       If r1 < 0 Then
          r1 = 0
       End If
       c = GetPixel(hdc, i - 1, j) '---左
       r2 = Red(c)
       If r2 > 255 Then
          r2 = 255
       End If
       If r2 < 0 Then
          r2 = 0
       End If
       c = GetPixel(hdc, i, j + 1) '---下
       r3 = Red(c)
       If r3 > 255 Then
          r3 = 255
       End If
       If r3 < 0 Then
          r3 = 0
       End If
       c = GetPixel(hdc, i + 1, j) '---右
       r4 = Red(c)
       If r4 > 255 Then
          r4 = 255
       End If
       If r4 < 0 Then
          r4 = 0
       End If
       c = GetPixel(hdc, i - 1, j - 1) '--左上
       r5 = Red(c)
       If r5 > 255 Then
          r5 = 255
       End If
       If r5 < 0 Then
          r5 = 0
       End If
       c = GetPixel(hdc, i + 1, j - 1) '---右上
       r6 = Red(c)
       If r6 > 255 Then
          r6 = 255
       End If
       If r6 < 0 Then
          r6 = 0
       End If
       c = GetPixel(hdc, i - 1, j + 1) '---左下
       r7 = Red(c)
       If r7 > 255 Then
          r7 = 255
       End If
       If r7 < 0 Then
          r7 = 0
       End If
       c = GetPixel(hdc, i + 1, j + 1) '---右下
       r8 = Red(c)
       If r8 > 255 Then
          r8 = 255
       End If
       If r8 < 0 Then
          r8 = 0
       End If
       
       If r = 0 Then '--------------------黑色
       
          If r1 = 0 Then '-----上面为黑色
             p(i, j) = p(i, j - 1)
             area(p(i, j)) = area(p(i, j)) + 1
             c = RGB(255, 255, 255)
             SetPixelV hdc, i, j, c
             GoTo pass1
          End If
          If r5 = 0 Then '-----左上面为黑色
             p(i, j) = p(i - 1, j - 1)
             c = RGB(255, 255, 255)
             GoTo pass1
          End If
          If r2 = 0 Then '-----左侧为黑色
             p(i, j) = p(i - 1, j)
             c = RGB(255, 255, 255)
             area(p(i, j)) = area(p(i, j)) + 1
             GoTo pass1
          End If
          If r7 = 0 Then '-----左下侧为黑色
             p(i, j) = p(i - 1, j + 1)
             c = RGB(255, 255, 255)
             area(p(i, j)) = area(p(i, j)) + 1
             GoTo pass1
          End If
          If r3 = 255 And r4 = 255 And r6 = 255 And r8 = 255 Then '----此点为白色包围，删除此点
              c = RGB(255, 255, 255)
              SetPixelV hdc, i, j, c
              GoTo pass1
          End If
          
          '----------------------------------------
          t = t + 1
          p(i, j) = t
          area(t) = area(t) + 1
          c = RGB(255, 255, 255)
          Me.Caption = p(i, j)
          
pass1:
       End If
       
    Next
 Next
 
     For i = 0 To t
       If area(i) > area(i + 1) Then
          maxitem = i
          Else
          maxitem = i + 1
       End If
     Next
     
     For i = 1 To Picture1.ScaleWidth
        For j = 1 To Picture1.ScaleHeight
          c = GetPixel(hdc, i, j)
          r = Red(c)
          If r < 255 Then
           If p(i, j) <> maxitem Then
             c = RGB(255, 255, 255)
             SetPixelV hdc, i, j, c
           End If
          End If
        Next
    Next

Answer 2

粗略看了一下算法，发现一个问题
既然扫描方法是“从上到下、从左到右地逐点扫描”，那么为何还要“首先检查当前点正上方的点”， 还要“依次检查当前点左上方的点p(i-1,j-1)、左方的点p(i-1,j),左下方的点,p(i-1,j+1)”？？？这些点不是已经扫描过了的吗？？你这个算法的原版我见过，检查每点周围的时候，是不用检查后面的。如下图： 1 2 3
 4 5 6
 7 8 9检查点5的时候，由于是从上到下、从左到右的检查，那么1，2，4，7都已经检查过了，无需检查。只需从3开始：3，6，9，8就够了。

Answer 3

感谢楼上的。实际上我的算法不是有BUG，而是错误的！因为下面的情况就会出错
              *        *
************00*00000000*
************************