Sub FloodFill (x As Int, y As Int)
Dim BorderColor As Int
Dim PBB (Canvas1.Width,Canvas1.Height) As Byte
Dim dir,b As Byte
Dim x1,y1 As Int
Dim xRange, yRange As Int
Dim ExitNow, NextPixel, PreviousPixel As Boolean
xRange = Canvas1.Width-1
yRange = Canvas1.Height-1
' Set the border colour to black - as used in the sample rectangle bitmap.
BorderColor = fx.Colors.Black
' Load the bitmap info into the array.
For y1 = 0 To yRange
For x1 = 0 To xRange
If Canvas1.Bitmap.GetPixel(x1,y1) = BorderColor Then
PBB(x1,y1) = 64
Else
PBB(x1,y1) = 0
End If
Next
Next
' Fill the edges with the defined border value.
y1 = 0
For x1 = 0 To xRange
PBB(x1,y1) = 64
Next
y1 = yRange
For x1 = 0 To xRange
PBB(x1,y1) = 64
Next
x1 = 0
For y1 = 0 To yRange
PBB(x1,y1) = 64
Next
x1 = xRange
For y1 = 0 To yRange
PBB(x1,y1) = 64
Next
' Set initial states, staring point, and direction.
ExitNow = False
NextPixel = True
PreviousPixel = False
PBB(x,y) = 136
dir = 0
' Do the calcs. Use a loop as the algorith was written using Goto statements which B4A doesn't support.
Do Until ExitNow
' Next Pixel
If NextPixel Then
Select dir
Case 0 : x=x+1
Case 1 : x=x-1
Case 2 : y=y-1
Case 3 : y=y+1
End Select
If Bit.And (PBB(x,y), 192) <> 0 Then
PreviousPixel = True
NextPixel = False
Else
PBB(x,y) = Bit.Or (128, dir) ' record fill + entry-direction
If dir <> 1 Then dir = 0 ' compute Exit direction
NextPixel = True
PreviousPixel = False
End If
End If
' Previous Pixel
If PreviousPixel Then
Select dir
Case 0 : x=x-1
Case 1 : x=x+1
Case 2 : y=y+1
Case 3 : y=y-1
End Select
b = PBB(x,y)
dir=dir+1
If Bit.And (b,15) = Bit.Xor (dir,1) Then dir=dir+1 ' skip entry directory.
If dir > 3 Then
dir = Bit.And (b, 15)
If dir >= 8 Then
ExitNow = True
Exit
Else
PreviousPixel = True
NextPixel= False
End If
Else
PreviousPixel = False
NextPixel= True
End If
End If ' PreviousPixel
Loop
' Update the mutable bitmap with the result from the array.
For y1 = 0 To yRange
For x1 = 0 To xRange
If Bit.And (PBB(x1,y1), 128) <> 0 Then
Canvas1.DrawPoint(x1, y1, ccolor) 'drawpoint there is no at b4j can be drawline(x1,y1,x1,y1...)
End If
Next
Next
End Sub