| 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 |
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 |