fix of region growing function vb6

I've implemented the region growing function for binary image, the function in VB 6.0 compares each pixel of the binary with original image 8-pixels RGB values. If the distance is equal or less than threshold then the pixels will added to the binary region. The functions adds some pixels in the boundary.

see the attached image which show you the error, I want it to add pixels only to the face region.

I need a VB 6.0 programmer to optimize and fix this code:

Public Sub ApplyGrowth(PicSource As PictureBox, PicBin As PictureBox, PicGrow As PictureBox, threshold As Double)

Dim QX(10000000) As Integer

Dim QY(10000000) As Integer

Dim isVisited() As Boolean

Dim dx(7) As Integer

Dim dy(7) As Integer

Dim Front As Long

Dim Back As Long

Dim CurX, NewX As Integer

Dim CurY, NewY As Integer

'Dim CurR, CurG, CurB, NewR, NewG, NewB As Double

Dim Area As Long

Dim x, y, z As Integer

dx(0) = 0

dx(1) = 1

dx(2) = 1

dx(3) = 1

dx(4) = 0

dx(5) = -1

dx(6) = -1

dx(7) = -1

dy(0) = -1

dy(1) = -1

dy(2) = 0

dy(3) = 1

dy(4) = 1

dy(5) = 1

dy(6) = 0

dy(7) = -1

Front = 0

Back = 0

ReDim isVisited(2000, 2000)

For y = 0 To [url removed, login to view] - 1

For x = 0 To [url removed, login to view] - 1

If ([url removed, login to view](x, y) = RGB(255, 255, 255)) Then

QX(Back) = x

QY(Back) = y

isVisited(y, x) = True

Back = Back + 1

End If

Next x

Next y

While (Front <= Back)

CurX = QX(Front)

CurY = QY(Front)

For z = 0 To 7

NewX = CurX + dx(z)

NewY = CurY + dy(z)

If NewX >= 0 And NewX < [url removed, login to view] And NewY >= 0 And NewY < [url removed, login to view] Then

If isVisited(NewY, NewX) = False Then

Dim CurR As Double

Dim CurG As Double

Dim CurB As Double

Dim NewR As Double

Dim NewG As Double

Dim NewB As Double

Dim dist As Double

ConvertRGB [url removed, login to view](CurX, CurY), CurR, CurG, CurB

ConvertRGB [url removed, login to view](NewX, NewY), NewR, NewG, NewB

dist = Abs(NewR - CurR) + Abs(NewG - CurG) + Abs(NewB - CurB)

If dist <= threshold Then

QX(Back) = NewX

QY(Back) = NewY

isVisited(NewY, NewX) = True

Back = Back + 1

End If

End If

End If

Next z

Front = Front + 1


For y = 0 To [url removed, login to view] - 1

For x = 0 To [url removed, login to view] - 1

If (isVisited(y, x) = True) Then

[url removed, login to view] (x, y), RGB(255, 255, 255)


[url removed, login to view] (x, y), RGB(0, 0, 0)

End If

Next x

Next y

End Sub

Evner: Visual Basic

Se mere: programmer vb6, function - 1 to 1, area of a point, redim, dx, curr, region code, vb6 function, picturebox image, boundary point code, VB6 Programmer, pixel point, region, boolean error fix, function point, vb6 image, vb6 fix, thousand delimiter vb function custom, pixel adds, front end back end visual basic, friends add face book, fix add things website today, face code vb, assign cell vb function call sheet, vb6 face

Om arbejdsgiveren:
( 13 bedømmelser ) Baghdad, Iraq

Projekt ID: #6029079