[DBC] Flood Fill using Memblock - GameCreators Forum

Author

Message

Ashingda 27

16

Years of Service

User Offline

Joined: 15th Feb 2008

Location:

Posted: 28th Jan 2009 06:16 Edited at: 30th Jan 2009 16:39

Link

I spent quite some time learning how to get a Floodfill in DBC. Still cant get it quite as fast as I'd like, I'm causing too many recrusions.

REM ******************************************************************
REM *                                                                *
REM *                DBClassic FloodFill Using Memblock              *
REM *                                                                *
REM ******************************************************************
REM * - Ashingda27                                                   *
REM ******************************************************************

REM I cannot seem to make this go any faster. >_< This version works
REM with both 16 bit and 32 bit modes. Click the screen to Fill!

REM I finnaly manage to get this to work with alot of help from Latch
REM who pretty much tought me how to use Memblock and binary and from
REM taking a peak at IanM's DBP version.

set display mode 640,480,16
create bitmap 1,640,480
sync on
sync rate 0

REM Global Variables for FloodFill Function
dim FloodWidth(0)
dim FloodHeight(0)
dim FloodBytes(0)
dim FloodTargetColor(0)
dim FloodFillColor(0)
dim ScanLeftUp(0)
dim ScanRightUp(0)
dim ScanLeftDn(0)
dim ScanRightDn(0)

dim ScanLeftU(0)
dim ScanLeftD(screen height())
dim ScanRightU(0)
dim ScanRightD(screen height())

REM Draws a Box with Text to be filled
ink rgb(255,255,255),0
box 320-25,240-5,320+25,240+10
ink 0,0
center text 320,240-5,"FloodFill"
ink rgb(255,255,255),0
text 0,0,"Click mouse to fill!"

line 320,10,320-100,10+100
line 320-100,10+100,320+100,10+100
line 320,10,320+100,10+100

circle 100,300,50
circle 150,350,50

box 400,300,450,350
box 500,300,550,350
line 400,325,500,325

set text opaque

REM **********************************************************************
REM Main Loop
REM **********************************************************************
do
	mc = mouseclick()
	mx = mousex()-1
	my = mousey()-1

if mc = 1
		if KeyM = 0
			REM Calling the Function
			T = Timer()
			FloodFill(mx,my,rgb(50,150,200))
			T = Timer()-T
		endif
		KeyM = 1
		else
		KeyM = 0
	endif

ink rgb(255,255,255),0
	text 200,0,"Speed: "+str$(T)+"   "

copy bitmap 1,0
	sync

loop

REM **********************************************************************
REM Function FloodFill
REM **********************************************************************
Function FloodFill(x,y,FillColor)

ScanLeftU(0) = x
	ScanLeftD(y) = x
	ScanRightU(0) = x
	ScanRightD(y) = x

REM Setting up for the Memblock command.	
	FloodWidth(0) = screen width()
	FloodHeight(0) = screen height()
	FloodBytes(0) = screen depth()/8

REM Creating the Memblock from the second Bitmap.
	make memblock from bitmap 1,1

REM Setting up the Fill color in 16 bit
	if FloodBytes(0) = 2
		r = (rgbr(FillColor)*63488)/255
		g = (rgbg(FillColor)*2016)/255
		b = (rgbb(FillColor)*31)/255
		FillColor = r | g | b
	endif

REM Getting the FillColor
	FloodFillColor(0) = FillColor

pos = 12+(x+y*FloodWidth(0))*FloodBytes(0)

REM 16 bit use Word
	if FloodBytes(0) = 2 then TargetColor = memblock word(1,pos)
	REM 32 bit use DWord
	if FloodBytes(0) = 4 then TargetColor = memblock dword(1,pos)

REM Getting the TargetColor
	FloodTargetColor(0) = TargetColor

ink FillColor,0

REM Calling the Loop
	if FloodTargetColor(0) <> FloodFillColor(0) then FloodLoop(x,y)

REM Convert to Image and paste onto screen
	make image from memblock 1,1
	paste image 1,0,0

EndFunction

REM **********************************************************************
REM Function FloodLoop
REM **********************************************************************
Function FloodLoop(x,y)

REM Left
   for Left = x to 0 step -1
		pos = 12+(Left+y*FloodWidth(0))*FloodBytes(0)
		REM 16 bit
		if FloodBytes(0) = 2
	      if memblock word(1,pos) <> FloodTargetColor(0) then exit
			write memblock word 1,pos,FloodFillColor(0)
		endif
		REM 32 bit
		if FloodBytes(0) = 4
	      if memblock dword(1,pos) <> FloodTargetColor(0) then exit
			write memblock dword 1,pos,FloodFillColor(0)
		endif
   next Left

REM Right
   for Right = x+1 to FloodWidth(0)-1
		pos = 12+(Right+y*FloodWidth(0))*FloodBytes(0)
		REM 16 bit
		if FloodBytes(0) = 2
   	   if memblock word(1,pos) <> FloodTargetColor(0) then exit
			write memblock word 1,pos,FloodFillColor(0)
		endif
		REM 32 bit
		if FloodBytes(0) = 4
   	   if memblock dword(1,pos) <> FloodTargetColor(0) then exit
			write memblock dword 1,pos,FloodFillColor(0)
		endif
   next Right

REM Up
	if y > 0
		for x = Left+1 to Right-1
			if x < ScanLeftU(0)+1 or x > ScanRightU(0)-1
				pos = 12+(x+(y-1)*FloodWidth(0))*FloodBytes(0)

REM 16 bit
				if FloodBytes(0) = 2 then i = memblock word(1,pos)
				REM 32 bit
				if FloodBytes(0) = 4 then i = memblock dword(1,pos)

REM Recall Function
				if i = FloodTargetColor(0)
					ScanLeftD(y-1) = Left+1
					ScanRightD(y-1) = Right-1
					FloodLoop(x,y-1)
					else
					if i <> FloodFillColor(0)
						ScanLeftU(0) = ScanLeftU(0) + 1
					endif
				endif
			endif
		next x
	endif

ScanLeftU(0) = Left+1
	ScanRightU(0) = Right-1

REM Down
	if y < FloodHeight(0)-2
		for x = Left+1 to Right-1

if x < ScanLeftD(y)+1 or x > ScanRightD(y)-1
				pos = 12+(x+(y+1)*FloodWidth(0))*FloodBytes(0)

REM 16 bit
				if FloodBytes(0) = 2 then i = memblock word(1,pos)
				REM 32 bit
				if FloodBytes(0) = 4 then i = memblock dword(1,pos)

REM Recall Function
				if i = FloodTargetColor(0)
					FloodLoop(x,y+1)
					else
					if i <> FloodFillColor(0)
						ScanLeftD(y) = ScanLeftD(y) + 1
					endif
				endif
			endif

next x
	endif

if y > 0
		ScanLeftD(y-1) = Left+1
		ScanRightD(y-1) = Right-1
	endif

EndFunction

+ Code Snippet

REM ******************************************************************
REM *                                                                *
REM *                DBClassic FloodFill Using Memblock              *
REM *                                                                *
REM ******************************************************************
REM * - Ashingda27                                                   *
REM ******************************************************************

REM I cannot seem to make this go any faster. >_< This version works
REM with both 16 bit and 32 bit modes. Click the screen to Fill!

REM I finnaly manage to get this to work with alot of help from Latch
REM who pretty much tought me how to use Memblock and binary and from
REM taking a peak at IanM's DBP version.


set display mode 640,480,16
create bitmap 1,640,480
sync on
sync rate 0

REM Global Variables for FloodFill Function
dim FloodWidth(0)
dim FloodHeight(0)
dim FloodBytes(0)
dim FloodTargetColor(0)
dim FloodFillColor(0)
dim ScanLeftUp(0)
dim ScanRightUp(0)
dim ScanLeftDn(0)
dim ScanRightDn(0)

dim ScanLeftU(0)
dim ScanLeftD(screen height())
dim ScanRightU(0)
dim ScanRightD(screen height())

REM Draws a Box with Text to be filled
ink rgb(255,255,255),0
box 320-25,240-5,320+25,240+10
ink 0,0
center text 320,240-5,"FloodFill"
ink rgb(255,255,255),0
text 0,0,"Click mouse to fill!"


line 320,10,320-100,10+100
line 320-100,10+100,320+100,10+100
line 320,10,320+100,10+100

circle 100,300,50
circle 150,350,50


box 400,300,450,350
box 500,300,550,350
line 400,325,500,325

set text opaque



REM **********************************************************************
REM Main Loop
REM **********************************************************************
do
	mc = mouseclick()
	mx = mousex()-1
	my = mousey()-1

	if mc = 1
		if KeyM = 0
			REM Calling the Function
			T = Timer()
			FloodFill(mx,my,rgb(50,150,200))
			T = Timer()-T
		endif
		KeyM = 1
		else
		KeyM = 0
	endif

	ink rgb(255,255,255),0
	text 200,0,"Speed: "+str$(T)+"   "

	copy bitmap 1,0
	sync

loop





REM **********************************************************************
REM Function FloodFill
REM **********************************************************************
Function FloodFill(x,y,FillColor)

	ScanLeftU(0) = x
	ScanLeftD(y) = x
	ScanRightU(0) = x
	ScanRightD(y) = x

	REM Setting up for the Memblock command.	
	FloodWidth(0) = screen width()
	FloodHeight(0) = screen height()
	FloodBytes(0) = screen depth()/8

	REM Creating the Memblock from the second Bitmap.
	make memblock from bitmap 1,1

	REM Setting up the Fill color in 16 bit
	if FloodBytes(0) = 2
		r = (rgbr(FillColor)*63488)/255
		g = (rgbg(FillColor)*2016)/255
		b = (rgbb(FillColor)*31)/255
		FillColor = r | g | b
	endif

	REM Getting the FillColor
	FloodFillColor(0) = FillColor



	pos = 12+(x+y*FloodWidth(0))*FloodBytes(0)

	REM 16 bit use Word
	if FloodBytes(0) = 2 then TargetColor = memblock word(1,pos)
	REM 32 bit use DWord
	if FloodBytes(0) = 4 then TargetColor = memblock dword(1,pos)

	REM Getting the TargetColor
	FloodTargetColor(0) = TargetColor

	ink FillColor,0

	REM Calling the Loop
	if FloodTargetColor(0) <> FloodFillColor(0) then FloodLoop(x,y)

	REM Convert to Image and paste onto screen
	make image from memblock 1,1
	paste image 1,0,0

EndFunction





REM **********************************************************************
REM Function FloodLoop
REM **********************************************************************
Function FloodLoop(x,y)

	REM Left
   for Left = x to 0 step -1
		pos = 12+(Left+y*FloodWidth(0))*FloodBytes(0)
		REM 16 bit
		if FloodBytes(0) = 2
	      if memblock word(1,pos) <> FloodTargetColor(0) then exit
			write memblock word 1,pos,FloodFillColor(0)
		endif
		REM 32 bit
		if FloodBytes(0) = 4
	      if memblock dword(1,pos) <> FloodTargetColor(0) then exit
			write memblock dword 1,pos,FloodFillColor(0)
		endif
   next Left

	REM Right
   for Right = x+1 to FloodWidth(0)-1
		pos = 12+(Right+y*FloodWidth(0))*FloodBytes(0)
		REM 16 bit
		if FloodBytes(0) = 2
   	   if memblock word(1,pos) <> FloodTargetColor(0) then exit
			write memblock word 1,pos,FloodFillColor(0)
		endif
		REM 32 bit
		if FloodBytes(0) = 4
   	   if memblock dword(1,pos) <> FloodTargetColor(0) then exit
			write memblock dword 1,pos,FloodFillColor(0)
		endif
   next Right


	REM Up
	if y > 0
		for x = Left+1 to Right-1
			if x < ScanLeftU(0)+1 or x > ScanRightU(0)-1
				pos = 12+(x+(y-1)*FloodWidth(0))*FloodBytes(0)

				REM 16 bit
				if FloodBytes(0) = 2 then i = memblock word(1,pos)
				REM 32 bit
				if FloodBytes(0) = 4 then i = memblock dword(1,pos)

				REM Recall Function
				if i = FloodTargetColor(0)
					ScanLeftD(y-1) = Left+1
					ScanRightD(y-1) = Right-1
					FloodLoop(x,y-1)
					else
					if i <> FloodFillColor(0)
						ScanLeftU(0) = ScanLeftU(0) + 1
					endif
				endif
			endif
		next x
	endif

	ScanLeftU(0) = Left+1
	ScanRightU(0) = Right-1


	REM Down
	if y < FloodHeight(0)-2
		for x = Left+1 to Right-1

			if x < ScanLeftD(y)+1 or x > ScanRightD(y)-1
				pos = 12+(x+(y+1)*FloodWidth(0))*FloodBytes(0)

				REM 16 bit
				if FloodBytes(0) = 2 then i = memblock word(1,pos)
				REM 32 bit
				if FloodBytes(0) = 4 then i = memblock dword(1,pos)

				REM Recall Function
				if i = FloodTargetColor(0)
					FloodLoop(x,y+1)
					else
					if i <> FloodFillColor(0)
						ScanLeftD(y) = ScanLeftD(y) + 1
					endif
				endif
			endif

		next x
	endif

	if y > 0
		ScanLeftD(y-1) = Left+1
		ScanRightD(y-1) = Right-1
	endif

EndFunction

Here's a slow verion if anyone's curious. It show what's going on and what checks are being made. You'll notice at the bottom there will be 3 colors being draw out as the object gets filled.

Green = Checked 1 time and Draw dot.
Red = Recrusive Check Upward.
Blue = Recrusive Check Downward.

sync on
sync rate 60

REM Global Variables for FloodFill Function
dim FloodWidth(0)
dim FloodHeight(0)
dim FloodBytes(0)
dim FloodTargetColor(0)
dim FloodFillColor(0)
dim ScanLeftUp(0)
dim ScanRightUp(0)
dim ScanLeftDn(0)
dim ScanRightDn(0)

dim ScanLeftU(1000)
dim ScanLeftD(1000)

dim ScanRightU(1000)
dim ScanRightD(1000)

dim c(0)

ink rgb(255,255,255),0
print "Press key with ready"

REM Shape 1
if This = 1
	ink rgb(255,255,255),0
	box 320-5,240-5,320+5,240+5
	box 320-10,240-10,320-5,240+10
	box 320+5,240-10,320+10,240+10
endif

REM Shape 2
if This = 1
	circle 320,240,10
endif

REM Shape 3
if This = 1
	box 320-10,240-5,320+10,240+5
	ink 0,0
	line 320-9,240-4,320-6,240+4
	line 320-6,240-4,320-3,240+4
	line 320-3,240-4,320-0,240+4
endif

REM Shape 4
if This = 0
	ink rgb(255,255,255),0
	box 320-15,240-7,320+10,240+7

ink 0,0
	box 320-9,240-5,320-5,240+5

box 320+5,240-5,320+9,240+5

line 320-9,240,320+9,240

endif

wait key
print "Start!"

T = Timer()
FloodFill(320-15,240-5,rgb(255,0,0))

ink rgb(255,255,255),0
print "End! ";Timer()-T
sync
END

REM **********************************************************************
REM Function FloodFill
REM **********************************************************************
Function FloodFill(x,y,FillColor)

FloodTargetColor(0) = point(x,y)
	FloodFillColor(0) = FillColor

ScanLeftU(0) = x
	ScanLeftD(y) = x
	ScanRightU(0) = x
	ScanRightD(y) = x

ink FloodFillColor(0),0

if FloodTargetColor(0) <> FloodFillColor(0) then FloodLoop(x,y)

EndFunction

REM **********************************************************************
REM Function FloodLoop
REM **********************************************************************
Function FloodLoop(x,y)

REM Left
   for Left = x to 0 step -1
		REM Scan Dot
		ink rgb(0,255,0),0
		dot Left,y+100
      if point(Left,y) <> FloodTargetColor(0) then exit
		ink FloodFillColor(0),0
		dot Left,y
   next Left

REM Right
   for Right = x+1 to 640
		REM Scan Dot
		ink rgb(0,255,0),0
		dot Right,y+100
      if point(Right,y) <> FloodTargetColor(0) then exit
		ink FloodFillColor(0),0
		dot Right,y
   next Right

ScanLeftU = ScanLeftU(0)
	ScanRightU = ScanRightU(0)

REM Vertical
	for x = Left+1 to Right-1

REM Up
		if x < ScanLeftU(0)+1 or x > ScanRightU(0)-1

REM Scan Dot
			ink rgb(255,0,0),0
			dot x,y+100-1

c = point(x,y-1)

if c = FloodTargetColor(0)
				ScanLeftD(y-1) = Left+1
				ScanRightD(y-1) = Right-1
				FloodLoop(x,y-1)
			endif

endif

next x

ScanLeftU(0) = Left+1
	ScanRightU(0) = Right-1

REM Down
	for x = Left+1 to Right-1

REM Down
		if x < ScanLeftD(y)+1 or x > ScanRightD(y)-1

REM Scan Dot
			ink rgb(0,0,255),0
			dot x,y+100+1

c = point(x,y+1)

if c = FloodTargetColor(0)
				FloodLoop(x,y+1)
			endif

endif
	next x

ScanLeftD(y-1) = Left+1
	ScanRightD(y-1) = Right-1

EndFunction

+ Code Snippet

sync on
sync rate 60


REM Global Variables for FloodFill Function
dim FloodWidth(0)
dim FloodHeight(0)
dim FloodBytes(0)
dim FloodTargetColor(0)
dim FloodFillColor(0)
dim ScanLeftUp(0)
dim ScanRightUp(0)
dim ScanLeftDn(0)
dim ScanRightDn(0)

dim ScanLeftU(1000)
dim ScanLeftD(1000)

dim ScanRightU(1000)
dim ScanRightD(1000)

dim c(0)

ink rgb(255,255,255),0
print "Press key with ready"


REM Shape 1
if This = 1
	ink rgb(255,255,255),0
	box 320-5,240-5,320+5,240+5
	box 320-10,240-10,320-5,240+10
	box 320+5,240-10,320+10,240+10
endif

REM Shape 2
if This = 1
	circle 320,240,10
endif

REM Shape 3
if This = 1
	box 320-10,240-5,320+10,240+5
	ink 0,0
	line 320-9,240-4,320-6,240+4
	line 320-6,240-4,320-3,240+4
	line 320-3,240-4,320-0,240+4
endif

REM Shape 4
if This = 0
	ink rgb(255,255,255),0
	box 320-15,240-7,320+10,240+7

	ink 0,0
	box 320-9,240-5,320-5,240+5

	box 320+5,240-5,320+9,240+5

	line 320-9,240,320+9,240

endif

wait key
print "Start!"


T = Timer()
FloodFill(320-15,240-5,rgb(255,0,0))


ink rgb(255,255,255),0
print "End! ";Timer()-T
sync
END


REM **********************************************************************
REM Function FloodFill
REM **********************************************************************
Function FloodFill(x,y,FillColor)

	FloodTargetColor(0) = point(x,y)
	FloodFillColor(0) = FillColor

	ScanLeftU(0) = x
	ScanLeftD(y) = x
	ScanRightU(0) = x
	ScanRightD(y) = x

	ink FloodFillColor(0),0

	if FloodTargetColor(0) <> FloodFillColor(0) then FloodLoop(x,y)

EndFunction





REM **********************************************************************
REM Function FloodLoop
REM **********************************************************************
Function FloodLoop(x,y)

	REM Left
   for Left = x to 0 step -1
		REM Scan Dot
		ink rgb(0,255,0),0
		dot Left,y+100
      if point(Left,y) <> FloodTargetColor(0) then exit
		ink FloodFillColor(0),0
		dot Left,y
   next Left

	REM Right
   for Right = x+1 to 640
		REM Scan Dot
		ink rgb(0,255,0),0
		dot Right,y+100
      if point(Right,y) <> FloodTargetColor(0) then exit
		ink FloodFillColor(0),0
		dot Right,y
   next Right



	ScanLeftU = ScanLeftU(0)
	ScanRightU = ScanRightU(0)


	REM Vertical
	for x = Left+1 to Right-1

		REM Up
		if x < ScanLeftU(0)+1 or x > ScanRightU(0)-1

			REM Scan Dot
			ink rgb(255,0,0),0
			dot x,y+100-1

			c = point(x,y-1)

			if c = FloodTargetColor(0)
				ScanLeftD(y-1) = Left+1
				ScanRightD(y-1) = Right-1
				FloodLoop(x,y-1)
			endif

		endif

	next x

	ScanLeftU(0) = Left+1
	ScanRightU(0) = Right-1


	REM Down
	for x = Left+1 to Right-1

		REM Down
		if x < ScanLeftD(y)+1 or x > ScanRightD(y)-1

			REM Scan Dot
			ink rgb(0,0,255),0
			dot x,y+100+1

			c = point(x,y+1)

			if c = FloodTargetColor(0)
				FloodLoop(x,y+1)
			endif

		endif
	next x

	ScanLeftD(y-1) = Left+1
	ScanRightD(y-1) = Right-1

EndFunction

Back to top

Profile PM Email

Ashingda 27

16

Years of Service

User Offline

Joined: 15th Feb 2008

Location:

Posted: 31st Jan 2009 01:01 Edited at: 31st Jan 2009 01:18

Link

I've optimized this to the best of my abilities and the speed has greatly improved. I tested this same code in DBPro and it works but only in the 32bit mode and it runs a bit slower. The default text size are different too

.

How do we get the equivelant of "color = r|g|b" in DBPro as this line doesn't seem to work?

REM ******************************************************************
REM *                                                                *
REM *                DBClassic FloodFill Using Memblock              *
REM *                                                                *
REM ******************************************************************
REM * - Ashingda27                                                   *
REM ******************************************************************

set display mode 640,480,16
create bitmap 1,640,480
sync on
sync rate 0

REM Global Variables for FloodFill Function
dim FloodWidth(0)
dim FloodHeight(0)
dim FloodBytes(0)
dim FloodTargetColor(0)
dim FloodFillColor(0)

dim ScanLeftU(0)
dim ScanRightU(0)
dim ScanLeftD(screen height())
dim ScanRightD(screen height())

REM Setting up for the Memblock command.	
FloodWidth(0) = screen width()
FloodHeight(0) = screen height()
FloodBytes(0) = screen depth()/8

REM Draws a Box with Text to be filled
ink rgb(255,255,255),0
box 320-25,240-5,320+25,240+10
ink 0,0
center text 320,240-5,"FloodFill"
ink rgb(255,255,255),0
text 0,0,"Click mouse to fill!"

line 320,10,320-100,10+100
line 320-100,10+100,320+100,10+100
line 320,10,320+100,10+100

circle 100,300,50
circle 150,350,50

box 400,300,450,350
box 500,300,550,350
line 400,325,500,325

set text opaque

REM **********************************************************************
REM Main Loop
REM **********************************************************************
do
	mc = mouseclick()
	mx = mousex()-1
	my = mousey()-1

if mc = 1
		if KeyM = 0
			REM Calling the Function
			T = Timer()
			c = rgb(rnd(255),rnd(255),rnd(255))
			FloodFill(mx,my,c)
			T = Timer()-T
		endif
		KeyM = 1
		else
		KeyM = 0
	endif

ink rgb(255,255,255),0
	text 200,0,"Speed: "+str$(T)+"   "

copy bitmap 1,0
	sync

loop

REM **********************************************************************
REM Function FloodFill
REM **********************************************************************
Function FloodFill(x,y,FillColor)

ScanLeftU(0) = 0
	ScanLeftD(y) = 0
	ScanRightU(0) = 0
	ScanRightD(y) = 0

REM Creating the Memblock from the second Bitmap.
	make memblock from bitmap 1,1

REM 16Bit Mode or 32bit mode
	if FloodBytes(0) = 2

REM Getting the FillColor
		r = (rgbr(FillColor)*63488)/255
		g = (rgbg(FillColor)*2016)/255
		b = (rgbb(FillColor)*31)/255
		FloodFillColor(0) = r | g | b
		REM Getting Target Color
		pos = 12+(x+y*FloodWidth(0))*FloodBytes(0)
		FloodTargetColor(0) = memblock word(1,pos)
		REM Fills the first Dot
		write memblock word 1,pos,FloodFillColor(0)

else

REM Getting the FillColor
		FloodFillColor(0) = FillColor
		REM Getting Target Color
		pos = 12+(x+y*FloodWidth(0))*FloodBytes(0)
		FloodTargetColor(0) = memblock dword(1,pos)
		REM Fills the first Dot
		write memblock dword 1,pos,FloodFillColor(0)

endif

REM Calling the FloodLoop
	if FloodTargetColor(0) <> FloodFillColor(0) then FloodLoop(x,y)

REM Convert to Image and paste onto screen
	make image from memblock 1,1
	paste image 1,0,0

for y = 0 to FloodHeight(0)
		ScanLeftD(y) = 0
		ScanRightD(y) = 0
	next y

EndFunction

REM **********************************************************************
REM Function FloodLoop
REM **********************************************************************
Function FloodLoop(x,y)

posY = y*FloodWidth(0)*FloodBytes(0)

REM Left
   for Left = x-1 to 0 step -1
		pos = 12+Left*FloodBytes(0)+posY
		REM Check 16bit or 32bit
		if FloodBytes(0) = 2
	      if memblock word(1,pos) <> FloodTargetColor(0) then exit
			write memblock word 1,pos,FloodFillColor(0)
			else
	      if memblock dword(1,pos) <> FloodTargetColor(0) then exit
			write memblock dword 1,pos,FloodFillColor(0)
		endif
   next Left
	inc Left

REM Right
   for Right = x+1 to FloodWidth(0)-1
		pos = 12+Right*FloodBytes(0)+posY
		REM Check 16bit or 32bit
		if FloodBytes(0) = 2
   	   if memblock word(1,pos) <> FloodTargetColor(0) then exit
			write memblock word 1,pos,FloodFillColor(0)
			else
   	   if memblock dword(1,pos) <> FloodTargetColor(0) then exit
			write memblock dword 1,pos,FloodFillColor(0)
		endif
   next Right
	dec Right

REM Move Up
	dec y
	posY = y*FloodWidth(0)*FloodBytes(0)

if y > 0

for x = Left to Right

if x < ScanLeftU(0) or x > ScanRightU(0)

pos = 12+x*FloodBytes(0)+posY

REM Check 16bit or 32bit
				if FloodBytes(0) = 2
					if memblock word(1,pos) = FloodTargetColor(0)
						ScanLeftD(y) = Left
						ScanRightD(y) = Right
						write memblock word 1,pos,FloodFillColor(0)
						FloodLoop(x,y)
					endif
					else
					if memblock dword(1,12+x*FloodBytes(0)+posY) = FloodTargetColor(0)
						ScanLeftD(y) = Left
						ScanRightD(y) = Right
						write memblock dword 1,pos,FloodFillColor(0)
						FloodLoop(x,y)
					endif
				endif

else
				x = ScanRightU(0)+1

endif

next x

endif
	inc y

ScanLeftU(0) = Left
	ScanRightU(0) = Right

REM Move Down
	ScanY = y
	inc y
	posY = y*FloodWidth(0)*FloodBytes(0)

if y < FloodHeight(0)-1

for x = Left to Right

if x < ScanLeftD(ScanY) or x > ScanRightD(ScanY)

pos = 12+x*FloodBytes(0)+posY

REM Check 16bit or 32bit
				if FloodBytes(0) = 2
					if memblock word(1,pos) = FloodTargetColor(0)
						write memblock word 1,pos,FloodFillColor(0)
						FloodLoop(x,y)
					endif
					else
					if memblock dword(1,pos) = FloodTargetColor(0)
						write memblock dword 1,pos,FloodFillColor(0)
						FloodLoop(x,y)
					endif
				endif

else
				x = ScanRightD(ScanY)+1

endif

next x

endif
	dec y

if y > 0
		ScanLeftD(y-1) = Left
		ScanRightD(y-1) = Right
	endif

EndFunction

+ Code Snippet

REM ******************************************************************
REM *                                                                *
REM *                DBClassic FloodFill Using Memblock              *
REM *                                                                *
REM ******************************************************************
REM * - Ashingda27                                                   *
REM ******************************************************************

set display mode 640,480,16
create bitmap 1,640,480
sync on
sync rate 0

REM Global Variables for FloodFill Function
dim FloodWidth(0)
dim FloodHeight(0)
dim FloodBytes(0)
dim FloodTargetColor(0)
dim FloodFillColor(0)

dim ScanLeftU(0)
dim ScanRightU(0)
dim ScanLeftD(screen height())
dim ScanRightD(screen height())

REM Setting up for the Memblock command.	
FloodWidth(0) = screen width()
FloodHeight(0) = screen height()
FloodBytes(0) = screen depth()/8




REM Draws a Box with Text to be filled
ink rgb(255,255,255),0
box 320-25,240-5,320+25,240+10
ink 0,0
center text 320,240-5,"FloodFill"
ink rgb(255,255,255),0
text 0,0,"Click mouse to fill!"


line 320,10,320-100,10+100
line 320-100,10+100,320+100,10+100
line 320,10,320+100,10+100

circle 100,300,50
circle 150,350,50


box 400,300,450,350
box 500,300,550,350
line 400,325,500,325

set text opaque



REM **********************************************************************
REM Main Loop
REM **********************************************************************
do
	mc = mouseclick()
	mx = mousex()-1
	my = mousey()-1

	if mc = 1
		if KeyM = 0
			REM Calling the Function
			T = Timer()
			c = rgb(rnd(255),rnd(255),rnd(255))
			FloodFill(mx,my,c)
			T = Timer()-T
		endif
		KeyM = 1
		else
		KeyM = 0
	endif

	ink rgb(255,255,255),0
	text 200,0,"Speed: "+str$(T)+"   "

	copy bitmap 1,0
	sync

loop





REM **********************************************************************
REM Function FloodFill
REM **********************************************************************
Function FloodFill(x,y,FillColor)

	ScanLeftU(0) = 0
	ScanLeftD(y) = 0
	ScanRightU(0) = 0
	ScanRightD(y) = 0

	REM Creating the Memblock from the second Bitmap.
	make memblock from bitmap 1,1

	REM 16Bit Mode or 32bit mode
	if FloodBytes(0) = 2

		REM Getting the FillColor
		r = (rgbr(FillColor)*63488)/255
		g = (rgbg(FillColor)*2016)/255
		b = (rgbb(FillColor)*31)/255
		FloodFillColor(0) = r | g | b
		REM Getting Target Color
		pos = 12+(x+y*FloodWidth(0))*FloodBytes(0)
		FloodTargetColor(0) = memblock word(1,pos)
		REM Fills the first Dot
		write memblock word 1,pos,FloodFillColor(0)

		else

		REM Getting the FillColor
		FloodFillColor(0) = FillColor
		REM Getting Target Color
		pos = 12+(x+y*FloodWidth(0))*FloodBytes(0)
		FloodTargetColor(0) = memblock dword(1,pos)
		REM Fills the first Dot
		write memblock dword 1,pos,FloodFillColor(0)

	endif


	REM Calling the FloodLoop
	if FloodTargetColor(0) <> FloodFillColor(0) then FloodLoop(x,y)

	REM Convert to Image and paste onto screen
	make image from memblock 1,1
	paste image 1,0,0

	for y = 0 to FloodHeight(0)
		ScanLeftD(y) = 0
		ScanRightD(y) = 0
	next y

EndFunction





REM **********************************************************************
REM Function FloodLoop
REM **********************************************************************
Function FloodLoop(x,y)

	posY = y*FloodWidth(0)*FloodBytes(0)

	REM Left
   for Left = x-1 to 0 step -1
		pos = 12+Left*FloodBytes(0)+posY
		REM Check 16bit or 32bit
		if FloodBytes(0) = 2
	      if memblock word(1,pos) <> FloodTargetColor(0) then exit
			write memblock word 1,pos,FloodFillColor(0)
			else
	      if memblock dword(1,pos) <> FloodTargetColor(0) then exit
			write memblock dword 1,pos,FloodFillColor(0)
		endif
   next Left
	inc Left

	REM Right
   for Right = x+1 to FloodWidth(0)-1
		pos = 12+Right*FloodBytes(0)+posY
		REM Check 16bit or 32bit
		if FloodBytes(0) = 2
   	   if memblock word(1,pos) <> FloodTargetColor(0) then exit
			write memblock word 1,pos,FloodFillColor(0)
			else
   	   if memblock dword(1,pos) <> FloodTargetColor(0) then exit
			write memblock dword 1,pos,FloodFillColor(0)
		endif
   next Right
	dec Right


	REM Move Up
	dec y
	posY = y*FloodWidth(0)*FloodBytes(0)

	if y > 0

		for x = Left to Right

			if x < ScanLeftU(0) or x > ScanRightU(0)

				pos = 12+x*FloodBytes(0)+posY

				REM Check 16bit or 32bit
				if FloodBytes(0) = 2
					if memblock word(1,pos) = FloodTargetColor(0)
						ScanLeftD(y) = Left
						ScanRightD(y) = Right
						write memblock word 1,pos,FloodFillColor(0)
						FloodLoop(x,y)
					endif
					else
					if memblock dword(1,12+x*FloodBytes(0)+posY) = FloodTargetColor(0)
						ScanLeftD(y) = Left
						ScanRightD(y) = Right
						write memblock dword 1,pos,FloodFillColor(0)
						FloodLoop(x,y)
					endif
				endif

				else
				x = ScanRightU(0)+1

			endif

		next x

	endif
	inc y

	ScanLeftU(0) = Left
	ScanRightU(0) = Right


	REM Move Down
	ScanY = y
	inc y
	posY = y*FloodWidth(0)*FloodBytes(0)

	if y < FloodHeight(0)-1

		for x = Left to Right

			if x < ScanLeftD(ScanY) or x > ScanRightD(ScanY)

				pos = 12+x*FloodBytes(0)+posY

				REM Check 16bit or 32bit
				if FloodBytes(0) = 2
					if memblock word(1,pos) = FloodTargetColor(0)
						write memblock word 1,pos,FloodFillColor(0)
						FloodLoop(x,y)
					endif
					else
					if memblock dword(1,pos) = FloodTargetColor(0)
						write memblock dword 1,pos,FloodFillColor(0)
						FloodLoop(x,y)
					endif
				endif

				else
				x = ScanRightD(ScanY)+1

			endif

		next x

	endif
	dec y

	if y > 0
		ScanLeftD(y-1) = Left
		ScanRightD(y-1) = Right
	endif

EndFunction

The slow testing version has also been greatly improved.

sync on
sync rate 60

REM Global Variables for FloodFill Function
dim FloodWidth(0)
dim FloodHeight(0)
dim FloodBytes(0)
dim FloodTargetColor(0)
dim FloodFillColor(0)

dim ScanLeftU(1000)
dim ScanLeftD(1000)

dim ScanRightU(1000)
dim ScanRightD(1000)

dim key(640,480)
dim key2(640,480)

ink rgb(255,255,255),0
text 320,0, "Press key with ready"

x = 320
y = 240

REM Shape 1
if This = 1
	ink rgb(255,255,255),0
	box 320-5,240-5,320+5,240+5
	box 320-10,240-10,320-5,240+10
	box 320+5,240-10,320+10,240+10
endif

REM Shape 2 Circle
if This = 0
	circle 320,240,10
	y = y + 5
endif

REM Shape 3
if This = 1
	box 320-10,240-5,320+10,240+5
	ink 0,0
	line 320-9,240-4,320-6,240+4
	line 320-6,240-4,320-3,240+4
	line 320-3,240-4,320-0,240+4
endif

REM Shape 4
if This = 1
	ink rgb(255,255,255),0
	box 320-15,240-7,320+10,240+7

ink 0,0
	box 320-9,240-5,320-5,240+5

box 320+5,240-5,320+9,240+5

line 320-9,240,320+9,240

x = 320-15
	y = 240-5
endif

`wait key
`print "Start!"

T = Timer()
FloodFill(x,y,rgb(255,0,0))

`ink rgb(255,255,255),0
`print "End! ";Timer()-T
sync
END

REM **********************************************************************
REM Function FloodFill
REM **********************************************************************
Function FloodFill(x,y,FillColor)

FloodTargetColor(0) = point(x,y)
	FloodFillColor(0) = FillColor

REM First Filled dot
	ink FloodFillColor(0),0
	dot x,y

REM First Scan dot
	ink rgb(0,255,0),0
	dot x,y+100
	key(x,y) = key(x,y)+1
	key2(x,y) = 1

ScanLeftU(0) = x
	ScanLeftD(y) = x
	ScanRightU(0) = x
	ScanRightD(y) = x

ink FloodFillColor(0),0

if FloodTargetColor(0) <> FloodFillColor(0) then FloodLoop(x,y)

ink rgb(255,255,255),0

x1 = 0
	y1 = 0

for y = 240-12 to 240+12
	for x = 320-12 to 320+12
		x1 = x1 + 13
		c = c + key(x,y)
		ink rgb(100,100,100),0
		box x1,y1,x1+12,y1+12
		if key(x,y) = 1 then ink rgb(0,255,0),0 else ink rgb(255,150,150),0
		if key2(x,y) = 0 then ink rgb(255,255,255),0
		if key(x,y) = 0 then ink rgb(200,200,200),0
		box x1,y1,x1+11,y1+11
		ink 0,0
		if key(x,y) = 1 then ink 0,0
		if key(x,y) > 1 then ink rgb(255,0,0),0
		text x1+3,y1-2,str$(key(x,y))

next x
		y1 = y1 + 13
		x1 = 0
	next y

ink rgb(255,255,255),0
	text 420,15,"Count: "+str$(c)
EndFunction

REM **********************************************************************
REM Function FloodLoop
REM **********************************************************************
Function FloodLoop(x,y)

REM Left
   for Left = x-1 to 0 step -1

REM Scan Dot
		ink rgb(0,255,0),0
		dot Left,y+100
		key(Left,y) = key(Left,y)+1

if point(Left,y) <> FloodTargetColor(0) then exit
		ink FloodFillColor(0),0
		dot Left,y
		key2(Left,y) = 1
   next Left
	inc Left

REM Right
   for Right = x+1 to 640

REM Scan Dot
		ink rgb(0,255,0),0
		dot Right,y+100
		key(Right,y) = key(Right,y)+1

if point(Right,y) <> FloodTargetColor(0) then exit
		ink FloodFillColor(0),0
		dot Right,y
		key2(Right,y) = 1
   next Right
	dec Right

i$ = inkey$()
	if i$ = "1" then end

REM Move Up - scan RED dots
	for x = Left to Right

REM Up
		if x < ScanLeftU(0) or x > ScanRightU(0)

if point(x,y-1) = FloodTargetColor(0)

ink rgb(0,255,0),0
				dot x,y+100-1
				key(x,y-1) = key(x,y-1)+1

ScanLeftD(y-1) = Left
				ScanRightD(y-1) = Right

ink FloodFillColor(0),0
				dot x,y-1
				key2(x,y-1) = 1

FloodLoop(x,y-1)

else
				
				ink rgb(255,0,0),0
				dot x,y+100-1
				key(x,y-1) = key(x,y-1)+1

endif

else
			x = ScanRightU(0)+1

endif

next x

ScanLeftU(0) = Left
	ScanRightU(0) = Right

REM Move Down - scan BLUE dots
	for x = Left to Right

REM Down
		if x < ScanLeftD(y) or x > ScanRightD(y)

if point(x,y+1) = FloodTargetColor(0)

ink rgb(0,255,0),0
				dot x,y+100+1
				key(x,y+1) = key(x,y+1)+1

ink FloodFillColor(0),0
				dot x,y+1
				key2(x,y+1) = 1

ScanLeftU(0) = Left
				ScanRightU(0) = Right
				ScanLeftD(y-1) = Left
				ScanRightD(y-1) = Right

FloodLoop(x,y+1)

else

ink rgb(0,0,255),0
				dot x,y+100+1
				key(x,y+1) = key(x,y+1)+1
			endif

else
			x = ScanRightD(y)+1

endif

next x

ScanLeftD(y-1) = Left
	ScanRightD(y-1) = Right

EndFunction

+ Code Snippet

sync on
sync rate 60


REM Global Variables for FloodFill Function
dim FloodWidth(0)
dim FloodHeight(0)
dim FloodBytes(0)
dim FloodTargetColor(0)
dim FloodFillColor(0)

dim ScanLeftU(1000)
dim ScanLeftD(1000)

dim ScanRightU(1000)
dim ScanRightD(1000)

dim key(640,480)
dim key2(640,480)

ink rgb(255,255,255),0
text 320,0, "Press key with ready"

x = 320
y = 240

REM Shape 1
if This = 1
	ink rgb(255,255,255),0
	box 320-5,240-5,320+5,240+5
	box 320-10,240-10,320-5,240+10
	box 320+5,240-10,320+10,240+10
endif

REM Shape 2 Circle
if This = 0
	circle 320,240,10
	y = y + 5
endif

REM Shape 3
if This = 1
	box 320-10,240-5,320+10,240+5
	ink 0,0
	line 320-9,240-4,320-6,240+4
	line 320-6,240-4,320-3,240+4
	line 320-3,240-4,320-0,240+4
endif

REM Shape 4
if This = 1
	ink rgb(255,255,255),0
	box 320-15,240-7,320+10,240+7

	ink 0,0
	box 320-9,240-5,320-5,240+5

	box 320+5,240-5,320+9,240+5

	line 320-9,240,320+9,240

	x = 320-15
	y = 240-5
endif

`wait key
`print "Start!"


T = Timer()
FloodFill(x,y,rgb(255,0,0))


`ink rgb(255,255,255),0
`print "End! ";Timer()-T
sync
END


REM **********************************************************************
REM Function FloodFill
REM **********************************************************************
Function FloodFill(x,y,FillColor)

	FloodTargetColor(0) = point(x,y)
	FloodFillColor(0) = FillColor

	REM First Filled dot
	ink FloodFillColor(0),0
	dot x,y

	REM First Scan dot
	ink rgb(0,255,0),0
	dot x,y+100
	key(x,y) = key(x,y)+1
	key2(x,y) = 1

	ScanLeftU(0) = x
	ScanLeftD(y) = x
	ScanRightU(0) = x
	ScanRightD(y) = x


	ink FloodFillColor(0),0

	if FloodTargetColor(0) <> FloodFillColor(0) then FloodLoop(x,y)


	ink rgb(255,255,255),0

	x1 = 0
	y1 = 0

	for y = 240-12 to 240+12
	for x = 320-12 to 320+12
		x1 = x1 + 13
		c = c + key(x,y)
		ink rgb(100,100,100),0
		box x1,y1,x1+12,y1+12
		if key(x,y) = 1 then ink rgb(0,255,0),0 else ink rgb(255,150,150),0
		if key2(x,y) = 0 then ink rgb(255,255,255),0
		if key(x,y) = 0 then ink rgb(200,200,200),0
		box x1,y1,x1+11,y1+11
		ink 0,0
		if key(x,y) = 1 then ink 0,0
		if key(x,y) > 1 then ink rgb(255,0,0),0
		text x1+3,y1-2,str$(key(x,y))

	next x
		y1 = y1 + 13
		x1 = 0
	next y

	ink rgb(255,255,255),0
	text 420,15,"Count: "+str$(c)
EndFunction





REM **********************************************************************
REM Function FloodLoop
REM **********************************************************************
Function FloodLoop(x,y)

	REM Left
   for Left = x-1 to 0 step -1

		REM Scan Dot
		ink rgb(0,255,0),0
		dot Left,y+100
		key(Left,y) = key(Left,y)+1

      if point(Left,y) <> FloodTargetColor(0) then exit
		ink FloodFillColor(0),0
		dot Left,y
		key2(Left,y) = 1
   next Left
	inc Left

	REM Right
   for Right = x+1 to 640

		REM Scan Dot
		ink rgb(0,255,0),0
		dot Right,y+100
		key(Right,y) = key(Right,y)+1

      if point(Right,y) <> FloodTargetColor(0) then exit
		ink FloodFillColor(0),0
		dot Right,y
		key2(Right,y) = 1
   next Right
	dec Right

	i$ = inkey$()
	if i$ = "1" then end

	REM Move Up - scan RED dots
	for x = Left to Right

		REM Up
		if x < ScanLeftU(0) or x > ScanRightU(0)


			if point(x,y-1) = FloodTargetColor(0)

				ink rgb(0,255,0),0
				dot x,y+100-1
				key(x,y-1) = key(x,y-1)+1

				ScanLeftD(y-1) = Left
				ScanRightD(y-1) = Right

				ink FloodFillColor(0),0
				dot x,y-1
				key2(x,y-1) = 1

				FloodLoop(x,y-1)

				else
				
				ink rgb(255,0,0),0
				dot x,y+100-1
				key(x,y-1) = key(x,y-1)+1

			endif

			else
			x = ScanRightU(0)+1

		endif

	next x

	ScanLeftU(0) = Left
	ScanRightU(0) = Right


	REM Move Down - scan BLUE dots
	for x = Left to Right

		REM Down
		if x < ScanLeftD(y) or x > ScanRightD(y)

			if point(x,y+1) = FloodTargetColor(0)

				ink rgb(0,255,0),0
				dot x,y+100+1
				key(x,y+1) = key(x,y+1)+1

				ink FloodFillColor(0),0
				dot x,y+1
				key2(x,y+1) = 1

				ScanLeftU(0) = Left
				ScanRightU(0) = Right
				ScanLeftD(y-1) = Left
				ScanRightD(y-1) = Right

				FloodLoop(x,y+1)

				else

				ink rgb(0,0,255),0
				dot x,y+100+1
				key(x,y+1) = key(x,y+1)+1
			endif

			else
			x = ScanRightD(y)+1

		endif

	next x

	ScanLeftD(y-1) = Left
	ScanRightD(y-1) = Right

EndFunction

Back to top

Profile PM Email

Latch

17

Years of Service

User Offline

Joined: 23rd Jul 2006

Location:

Posted: 31st Jan 2009 01:57 Edited at: 31st Jan 2009 02:15

Link

I think bitwise OR is || in DBPro :

r||g||b

I see you made good use of the 16 bit conversion algorithm I showed you. You may want to include a test for different conversion types, 565, 555... but in most cases it will be 565.

Enjoy your day.

Back to top

Profile PM

Quadrazar

15

Years of Service

User Offline

Joined: 7th Jan 2009

Location: onboard the Kobayashi Maru

Posted: 31st Jan 2009 02:58

Link

The 32bits version is probably running slower because it has to write twice as much data compared to the 16 bit version. For a sqaure this would result in (16bitWriteTime ^ 2) = 32bitWriteTime.
If your 32bit version stays whitin this limit the computing time of the 32Bit is probably faster.

Quote: "How do we get the equivelant of "color = r|g|b" in DBPro as this line doesn't seem to work?"

color = r+g+b
since there r,g and b have no 'overlapping' bits.

make shure r g and b are Integer values. otherwise you'll get strange results.

if you calculate
63488 / 255 = 248,97254901960784313725490196078 (float)
63488 / 256 = 248 (int)

for the others you'll have to use a round function I think

I'm not shure if the conversion is right.
It could be that I'm wrong (can't test it so...)
32blue has 8 bits
16blue has 5 bits
b = rgbb(FillColor) / 8 * 5 ( 8/5 = 1.25)
b has to be an Int and is probably a the float.
b = floor ( rgbb(FillColor)*1.25)

32green has 8 bits
16green has 5 (or 6 bits according to the hue thread)
g = rgbg(FillColor) / 8 * 5 * 16
g = floor(rgbg(FillColor) / 1.25) * 16 (Five bits version)
g = floor(rgbg(FillColor) / 1.5 ) * 16 (Six bits vesion)

and for red
r = floor( rgbr(FillColor) / 1.25) * 256 (Five bits version)
r = floor( rgbr(FillColor) / 1.25) * 512 (Six bits vesion)

I don't know if basic has floor or round commands. It sould round a integer to and int.

Amiga 500 - 68000 processor / 7 Mhz, 512 Kb RAM, 4-channel PCM synthesizer (stereo)

Back to top

Profile PM Email

Ashingda 27

16

Years of Service

User Offline

Joined: 15th Feb 2008

Location:

Posted: 31st Jan 2009 05:59 Edited at: 31st Jan 2009 06:10

Link

The bitwise OR || and Quadrazar's example are both not returning a correct value. 16bit mode is just not working at all for me while using memblock, not just the color, everything memblock related is just wrong.

I also notice that making a memblock from bitmap (Screen) DBP is faster than DBC but when making memblock from bitmap (Memory), DBC is MUCH faster!

I made 2 different versions of this in DBP, one using the Lock Pixels, Dot and Point, the other using Memblock.

Somthing's very funny with the two versions.

1) The Lock Pixel version would be blazing fast giving a return speed of 15 after filling a small object. Then when filling the screen it's slow, returning at about 500.

2) The Memblock will return at about 280~290 while filling the screen, but stays consistant while filling everything else even the smallest object.

I've also tried using get image and making memblock from image instead but do difference.

DBP Memblock version.

REM ******************************************************************
REM *                                                                *
REM *                  DBPro FloodFill Using Memblock                *
REM *                                                                *
REM ******************************************************************
REM * - Ashingda27                                                   *
REM ******************************************************************

set display mode 640,480,32
sync on
sync rate 0

wd = screen width()
ht = screen height()
dp = screen depth()

REM Global Variables for FloodFill Function
global FloodWidth as integer
global FloodHeight as integer
global FloodBytes as integer

global FloodTargetColor as integer
global FloodFillColor as integer

global ScanLeftU as integer
global ScanRightU as integer

global dim ScanLeftD(ht) as integer
global dim ScanRightD(ht) as integer

REM Setting up for the Memblock command.
FloodWidth = wd
FloodHeight = ht
FloodBytes = dp/8

create bitmap 1,wd,ht

REM Draws a Box with Text to be filled
ink rgb(255,255,255),0
box 320-25,240-5,320+25,240+10
ink 0,0
center text 320,240-5,"FloodFill"
ink rgb(255,255,255),0
text 0,0,"Click mouse to fill!"

line 320,10,320-100,10+100
line 320-100,10+100,320+100,10+100
line 320,10,320+100,10+100

circle 100,300,50
circle 150,350,50

box 400,300,450,350
box 500,300,550,350
line 400,325,500,325

set text opaque

mx as integer
my as integer
mc as integer
KeyM as integer
T as integer
c as integer

REM **********************************************************************
REM Main Loop
REM **********************************************************************
do
   mc = mouseclick()
   mx = mousex()
   my = mousey()

if mc = 1
      if KeyM = 0
         REM Calling the Function
         T = Timer()
         c = rgb(rnd(255),rnd(255),rnd(255))
         `c = rgb(255,255,0)
         FloodFill(mx,my,c)
         T = Timer()-T
      endif
      KeyM = 1
      else
      KeyM = 0
   endif

ink rgb(255,255,255),0
   text 200,0,"Speed: "+str$(T)+"   "
   `text 0,15,"Fps: "+str$(Screen fps())+"   "

copy bitmap 1,0
   sync

loop

REM **********************************************************************
REM Function FloodFill
REM **********************************************************************
Function FloodFill(x as integer,y as integer,FillColor as integer)

REM Reset Values
   ScanLeftU = x
   ScanRightU = x

for lp = 0 to FloodHeight
      ScanLeftD(lp) = x
      ScanRightD(lp) = x
   next lp

REM Creating the Memblock from the second Bitmap.
   make memblock from bitmap 1,1

REM 16Bit Mode or 32bit mode
   if FloodBytes = 2

local r as integer
      local g as integer
      local b as integer

REM Getting the FillColor
      r = (rgbr(FillColor)*63488.0)/255
      g = (rgbg(FillColor)*2016.0)/255
      b = (rgbb(FillColor)*31.0)/255
      FloodFillColor = r||g||b
      REM Getting Target Color
      pos = 12+(x+y*FloodWidth)*FloodBytes
      FloodTargetColor = memblock word(1,pos)
      REM Fills the first Dot
      write memblock word 1,pos,FloodFillColor

else

REM Getting the FillColor
      FloodFillColor = FillColor
      REM Getting Target Color
      pos = 12+(x+y*FloodWidth)*FloodBytes
      FloodTargetColor = memblock dword(1,pos)
      REM Fills the first Dot
      write memblock dword 1,pos,FloodFillColor

endif

REM Calling the FloodLoop
   if FloodTargetColor <> FloodFillColor then FloodLoop(x,y)

REM Convert to Image and paste onto screen
   make image from memblock 1,1
   paste image 1,0,0

EndFunction

REM **********************************************************************
REM Function FloodLoop
REM **********************************************************************
Function FloodLoop(x as integer,y as integer)

local Left as integer
   local Right as integer
   local posY as integer

posY = y*FloodWidth*FloodBytes

REM Left
   for Left = x-1 to 0 step -1
      pos = 12+(Left*FloodBytes)+posY
      REM Check 16bit or 32bit
      if FloodBytes = 2
         if memblock word(1,pos) <> FloodTargetColor then exit
         write memblock word 1,pos,FloodFillColor
         else
         if memblock dword(1,pos) <> FloodTargetColor then exit
         write memblock dword 1,pos,FloodFillColor
      endif
   next Left
   inc Left

REM Right
   for Right = x+1 to FloodWidth-1
      pos = 12+(Right*FloodBytes)+posY
      REM Check 16bit or 32bit
      if FloodBytes = 2
         if memblock word(1,pos) <> FloodTargetColor then exit
         write memblock word 1,pos,FloodFillColor
         else
         if memblock dword(1,pos) <> FloodTargetColor then exit
         write memblock dword 1,pos,FloodFillColor
      endif
   next Right
   dec Right

REM Move Up
   dec y
   posY = y*FloodWidth*FloodBytes

if y > 0

for x = Left to Right

if x < ScanLeftU or x > ScanRightU

pos = 12+(x*FloodBytes)+posY

REM Check 16bit or 32bit
            if FloodBytes = 2
               if memblock word(1,pos) = FloodTargetColor
                  ScanLeftD(y) = Left
                  ScanRightD(y) = Right
                  write memblock word 1,pos,FloodFillColor
                  FloodLoop(x,y)
               endif
               else
               if memblock dword(1,12+x*FloodBytes+posY) = FloodTargetColor
                  ScanLeftD(y) = Left
                  ScanRightD(y) = Right
                  write memblock dword 1,pos,FloodFillColor
                  FloodLoop(x,y)
               endif
            endif

else
            x = ScanRightU+1

endif

next x

endif
   inc y

ScanLeftU = Left
   ScanRightU = Right

REM Move Down
   ScanY = y
   inc y
   posY = y*FloodWidth*FloodBytes

if y < FloodHeight-1

for x = Left to Right

if x < ScanLeftD(ScanY) or x > ScanRightD(ScanY)

pos = 12+(x*FloodBytes)+posY

REM Check 16bit or 32bit
            if FloodBytes = 2
               if memblock word(1,pos) = FloodTargetColor
                  write memblock word 1,pos,FloodFillColor
                  FloodLoop(x,y)
               endif
               else
               if memblock dword(1,pos) = FloodTargetColor
                  write memblock dword 1,pos,FloodFillColor
                  FloodLoop(x,y)
               endif
            endif

else
            x = ScanRightD(ScanY)+1

endif

next x

endif
   dec y

if y > 0
      ScanLeftD(y-1) = Left
      ScanRightD(y-1) = Right
   endif

EndFunction

+ Code Snippet

REM ******************************************************************
REM *                                                                *
REM *                  DBPro FloodFill Using Memblock                *
REM *                                                                *
REM ******************************************************************
REM * - Ashingda27                                                   *
REM ******************************************************************

set display mode 640,480,32
sync on
sync rate 0

wd = screen width()
ht = screen height()
dp = screen depth()

REM Global Variables for FloodFill Function
global FloodWidth as integer
global FloodHeight as integer
global FloodBytes as integer

global FloodTargetColor as integer
global FloodFillColor as integer

global ScanLeftU as integer
global ScanRightU as integer

global dim ScanLeftD(ht) as integer
global dim ScanRightD(ht) as integer

REM Setting up for the Memblock command.
FloodWidth = wd
FloodHeight = ht
FloodBytes = dp/8

create bitmap 1,wd,ht

REM Draws a Box with Text to be filled
ink rgb(255,255,255),0
box 320-25,240-5,320+25,240+10
ink 0,0
center text 320,240-5,"FloodFill"
ink rgb(255,255,255),0
text 0,0,"Click mouse to fill!"


line 320,10,320-100,10+100
line 320-100,10+100,320+100,10+100
line 320,10,320+100,10+100

circle 100,300,50
circle 150,350,50


box 400,300,450,350
box 500,300,550,350
line 400,325,500,325

set text opaque

mx as integer
my as integer
mc as integer
KeyM as integer
T as integer
c as integer

REM **********************************************************************
REM Main Loop
REM **********************************************************************
do
   mc = mouseclick()
   mx = mousex()
   my = mousey()

   if mc = 1
      if KeyM = 0
         REM Calling the Function
         T = Timer()
         c = rgb(rnd(255),rnd(255),rnd(255))
         `c = rgb(255,255,0)
         FloodFill(mx,my,c)
         T = Timer()-T
      endif
      KeyM = 1
      else
      KeyM = 0
   endif

   ink rgb(255,255,255),0
   text 200,0,"Speed: "+str$(T)+"   "
   `text 0,15,"Fps: "+str$(Screen fps())+"   "

   copy bitmap 1,0
   sync

loop





REM **********************************************************************
REM Function FloodFill
REM **********************************************************************
Function FloodFill(x as integer,y as integer,FillColor as integer)

   REM Reset Values
   ScanLeftU = x
   ScanRightU = x

   for lp = 0 to FloodHeight
      ScanLeftD(lp) = x
      ScanRightD(lp) = x
   next lp

   REM Creating the Memblock from the second Bitmap.
   make memblock from bitmap 1,1

   REM 16Bit Mode or 32bit mode
   if FloodBytes = 2

      local r as integer
      local g as integer
      local b as integer

      REM Getting the FillColor
      r = (rgbr(FillColor)*63488.0)/255
      g = (rgbg(FillColor)*2016.0)/255
      b = (rgbb(FillColor)*31.0)/255
      FloodFillColor = r||g||b
      REM Getting Target Color
      pos = 12+(x+y*FloodWidth)*FloodBytes
      FloodTargetColor = memblock word(1,pos)
      REM Fills the first Dot
      write memblock word 1,pos,FloodFillColor

      else

      REM Getting the FillColor
      FloodFillColor = FillColor
      REM Getting Target Color
      pos = 12+(x+y*FloodWidth)*FloodBytes
      FloodTargetColor = memblock dword(1,pos)
      REM Fills the first Dot
      write memblock dword 1,pos,FloodFillColor

   endif

   REM Calling the FloodLoop
   if FloodTargetColor <> FloodFillColor then FloodLoop(x,y)

   REM Convert to Image and paste onto screen
   make image from memblock 1,1
   paste image 1,0,0

EndFunction





REM **********************************************************************
REM Function FloodLoop
REM **********************************************************************
Function FloodLoop(x as integer,y as integer)

   local Left as integer
   local Right as integer
   local posY as integer

   posY = y*FloodWidth*FloodBytes

   REM Left
   for Left = x-1 to 0 step -1
      pos = 12+(Left*FloodBytes)+posY
      REM Check 16bit or 32bit
      if FloodBytes = 2
         if memblock word(1,pos) <> FloodTargetColor then exit
         write memblock word 1,pos,FloodFillColor
         else
         if memblock dword(1,pos) <> FloodTargetColor then exit
         write memblock dword 1,pos,FloodFillColor
      endif
   next Left
   inc Left

   REM Right
   for Right = x+1 to FloodWidth-1
      pos = 12+(Right*FloodBytes)+posY
      REM Check 16bit or 32bit
      if FloodBytes = 2
         if memblock word(1,pos) <> FloodTargetColor then exit
         write memblock word 1,pos,FloodFillColor
         else
         if memblock dword(1,pos) <> FloodTargetColor then exit
         write memblock dword 1,pos,FloodFillColor
      endif
   next Right
   dec Right


   REM Move Up
   dec y
   posY = y*FloodWidth*FloodBytes

   if y > 0

      for x = Left to Right

         if x < ScanLeftU or x > ScanRightU

            pos = 12+(x*FloodBytes)+posY

            REM Check 16bit or 32bit
            if FloodBytes = 2
               if memblock word(1,pos) = FloodTargetColor
                  ScanLeftD(y) = Left
                  ScanRightD(y) = Right
                  write memblock word 1,pos,FloodFillColor
                  FloodLoop(x,y)
               endif
               else
               if memblock dword(1,12+x*FloodBytes+posY) = FloodTargetColor
                  ScanLeftD(y) = Left
                  ScanRightD(y) = Right
                  write memblock dword 1,pos,FloodFillColor
                  FloodLoop(x,y)
               endif
            endif

            else
            x = ScanRightU+1

         endif

      next x

   endif
   inc y

   ScanLeftU = Left
   ScanRightU = Right


   REM Move Down
   ScanY = y
   inc y
   posY = y*FloodWidth*FloodBytes

   if y < FloodHeight-1

      for x = Left to Right

         if x < ScanLeftD(ScanY) or x > ScanRightD(ScanY)

            pos = 12+(x*FloodBytes)+posY

            REM Check 16bit or 32bit
            if FloodBytes = 2
               if memblock word(1,pos) = FloodTargetColor
                  write memblock word 1,pos,FloodFillColor
                  FloodLoop(x,y)
               endif
               else
               if memblock dword(1,pos) = FloodTargetColor
                  write memblock dword 1,pos,FloodFillColor
                  FloodLoop(x,y)
               endif
            endif

            else
            x = ScanRightD(ScanY)+1

         endif

      next x

   endif
   dec y

   if y > 0
      ScanLeftD(y-1) = Left
      ScanRightD(y-1) = Right
   endif

EndFunction

DBP Lock Pixel version

REM ******************************************************************
REM *                                                                *
REM *                        DBPro FloodFill                         *
REM *                                                                *
REM ******************************************************************
REM * - Ashingda27                                                   *
REM ******************************************************************

set display mode 640,480,32
create bitmap 1,640,480
sync on
sync rate 0

REM Global Variables for FloodFill Function
global FloodWidth as integer
global FloodHeight as integer
global FloodBytes as integer
global FloodTargetColor as integer
global FloodFillColor as integer

global ScanLeftU as integer
global ScanRightU as integer

dim ScanLeftD(screen height())
dim ScanRightD(screen height())

REM Setting up for the Memblock command.
FloodWidth = screen width()
FloodHeight = screen height()
FloodBytes = screen depth()/8

REM Draws a Box with Text to be filled
ink rgb(255,255,255),0
box 320-25,240-5,320+25,240+10
ink 0,0
center text 320,240-5,"FloodFill"
ink rgb(255,255,255),0
text 0,0,"Click mouse to fill!"

line 320,10,320-100,10+100
line 320-100,10+100,320+100,10+100
line 320,10,320+100,10+100

circle 100,300,50
circle 150,350,50

box 400,300,450,350
box 500,300,550,350
line 400,325,500,325

set text opaque

REM **********************************************************************
REM Main Loop
REM **********************************************************************
do
   mc = mouseclick()
   mx = mousex()-1
   my = mousey()-1

if mc = 1
      if KeyM = 0
         REM Calling the Function
         T = Timer()
         c = rgb(rnd(255),rnd(255),rnd(255))
         FloodFill(mx,my,c)
         T = Timer()-T
      endif
      KeyM = 1
      else
      KeyM = 0
   endif

ink rgb(255,255,255),0
   text 200,0,"Speed: "+str$(T)+"   "

copy bitmap 1,0
   sync

loop

REM **********************************************************************
REM Function FloodFill
REM **********************************************************************
Function FloodFill(x,y,FillColor)

lock pixels

ScanLeftU = 0
      ScanLeftD(y) = 0
      ScanRightU = 0
      ScanRightD(y) = 0

FloodTargetColor = point(x,y)
      FloodFillColor = FillColor
      ink FloodFillColor,0
      dot x,y

REM Start the Fill Loop
      if FloodTargetColor <> FloodFillColor then FloodLoop(x,y)

unlock pixels

REM Clear the Array
   for y = 0 to FloodHeight
      ScanLeftD(y) = 0
      ScanRightD(y) = 0
   next y

EndFunction

REM **********************************************************************
REM Function FloodLoop
REM **********************************************************************
Function FloodLoop(x,y)

REM Left
   for Left = x-1 to 0 step -1
      if point(Left,y) <> FloodTargetColor then exit
      dot Left,y
   next Left
   inc Left

REM Right
   for Right = x+1 to FloodWidth-1
      if point(Right,y) <> FloodTargetColor then exit
      dot Right,y
   next Right
   dec Right

`box Left,y,Right,y+1
   `line Left,y,Right,y

REM Move Up
   dec y
   if y > 0

for x = Left to Right

if x < ScanLeftU or x > ScanRightU

if point(x,y) = FloodTargetColor
               ScanLeftD(y) = Left
               ScanRightD(y) = Right
               dot x,y
               FloodLoop(x,y)
            endif

else
            x = ScanRightU+1

endif

next x

endif
   inc y

ScanLeftU = Left
   ScanRightU = Right

REM Move Down
   ScanY = y
   inc y
   if y < FloodHeight-1

for x = Left to Right

if x < ScanLeftD(ScanY) or x > ScanRightD(ScanY)

if point(x,y) = FloodTargetColor
               dot x,y
               FloodLoop(x,y)
            endif

else
            x = ScanRightD(ScanY)+1

endif

next x

endif
   dec y

if y > 0
      ScanLeftD(y-1) = Left
      ScanRightD(y-1) = Right
   endif

EndFunction

+ Code Snippet

REM ******************************************************************
REM *                                                                *
REM *                        DBPro FloodFill                         *
REM *                                                                *
REM ******************************************************************
REM * - Ashingda27                                                   *
REM ******************************************************************

set display mode 640,480,32
create bitmap 1,640,480
sync on
sync rate 0

REM Global Variables for FloodFill Function
global FloodWidth as integer
global FloodHeight as integer
global FloodBytes as integer
global FloodTargetColor as integer
global FloodFillColor as integer

global ScanLeftU as integer
global ScanRightU as integer

dim ScanLeftD(screen height())
dim ScanRightD(screen height())

REM Setting up for the Memblock command.
FloodWidth = screen width()
FloodHeight = screen height()
FloodBytes = screen depth()/8




REM Draws a Box with Text to be filled
ink rgb(255,255,255),0
box 320-25,240-5,320+25,240+10
ink 0,0
center text 320,240-5,"FloodFill"
ink rgb(255,255,255),0
text 0,0,"Click mouse to fill!"


line 320,10,320-100,10+100
line 320-100,10+100,320+100,10+100
line 320,10,320+100,10+100

circle 100,300,50
circle 150,350,50


box 400,300,450,350
box 500,300,550,350
line 400,325,500,325

set text opaque



REM **********************************************************************
REM Main Loop
REM **********************************************************************
do
   mc = mouseclick()
   mx = mousex()-1
   my = mousey()-1

   if mc = 1
      if KeyM = 0
         REM Calling the Function
         T = Timer()
         c = rgb(rnd(255),rnd(255),rnd(255))
         FloodFill(mx,my,c)
         T = Timer()-T
      endif
      KeyM = 1
      else
      KeyM = 0
   endif

   ink rgb(255,255,255),0
   text 200,0,"Speed: "+str$(T)+"   "

   copy bitmap 1,0
   sync

loop





REM **********************************************************************
REM Function FloodFill
REM **********************************************************************
Function FloodFill(x,y,FillColor)

   lock pixels

      ScanLeftU = 0
      ScanLeftD(y) = 0
      ScanRightU = 0
      ScanRightD(y) = 0

      FloodTargetColor = point(x,y)
      FloodFillColor = FillColor
      ink FloodFillColor,0
      dot x,y

      REM Start the Fill Loop
      if FloodTargetColor <> FloodFillColor then FloodLoop(x,y)

   unlock pixels

   REM Clear the Array
   for y = 0 to FloodHeight
      ScanLeftD(y) = 0
      ScanRightD(y) = 0
   next y

EndFunction





REM **********************************************************************
REM Function FloodLoop
REM **********************************************************************
Function FloodLoop(x,y)

   REM Left
   for Left = x-1 to 0 step -1
      if point(Left,y) <> FloodTargetColor then exit
      dot Left,y
   next Left
   inc Left

   REM Right
   for Right = x+1 to FloodWidth-1
      if point(Right,y) <> FloodTargetColor then exit
      dot Right,y
   next Right
   dec Right

   `box Left,y,Right,y+1
   `line Left,y,Right,y

   REM Move Up
   dec y
   if y > 0

      for x = Left to Right

         if x < ScanLeftU or x > ScanRightU

            if point(x,y) = FloodTargetColor
               ScanLeftD(y) = Left
               ScanRightD(y) = Right
               dot x,y
               FloodLoop(x,y)
            endif

            else
            x = ScanRightU+1

         endif

      next x

   endif
   inc y

   ScanLeftU = Left
   ScanRightU = Right


   REM Move Down
   ScanY = y
   inc y
   if y < FloodHeight-1

      for x = Left to Right

         if x < ScanLeftD(ScanY) or x > ScanRightD(ScanY)


            if point(x,y) = FloodTargetColor
               dot x,y
               FloodLoop(x,y)
            endif

            else
            x = ScanRightD(ScanY)+1

         endif

      next x

   endif
   dec y

   if y > 0
      ScanLeftD(y-1) = Left
      ScanRightD(y-1) = Right
   endif

EndFunction

Back to top

Profile PM Email

Latch

17

Years of Service

User Offline

Joined: 23rd Jul 2006

Location:

Posted: 31st Jan 2009 08:32

Link

Could be a couple of different things. Does DBPro run in a window by default? If so, the bitmaps will most likely take on the bit depth of your desktop (which is probably 32 bit) no matter what you set display mode at. Also check the memblock data itself. 16 bit color may actually be split into 3 bytes already inside the memblock if you are running in fullscreen mode. 16 bit may also be rgb1555 meaning there's a bit reserved for an alpha channel in DBPro.

Quote: "color = r+g+b
since there r,g and b have no 'overlapping' bits."

I was under the impression that a bitwise OR operation would be faster than an addition because it eliminates the check for a carry. And since we don't need a carry...

Enjoy your day.

Back to top

Profile PM

Ashingda 27

16

Years of Service

User Offline

Joined: 15th Feb 2008

Location:

Posted: 31st Jan 2009 15:35 Edited at: 31st Jan 2009 16:09

Link

DBP has a separate .exe display setting aside from the set display statement and the default usually is windowed fullscreen.

I had the bit dept checking the memblock data as you suggested and it works! Aparently the screen depth() function isn't really reliable

.

My desktop setting is in 32bit and it seems the only time DBP will actually be in actual 16bit mode is in exclusive mode with both display settings, the statement and .exe settings are set to 16bit. Or just not use the statement at all and only the .exe sittings.

I'm still having some issues with the 16bit mode. After filling a circle, then I fill a triangle, I notice that the previous circle is refilled with a different color. I'm not sure what's causing this lol.

[edit]

This is confusing I skipped the whole process of filling and only:

1) Made the memblock from bitmap
2) Convert the color into 2 bytes
3) Plot one pixel
4) Make image from memblock and paste

I'm still getting the previous color changing every time I click the mouse.

Attachments

Login to view attachments

Back to top

Profile PM Email

Ashingda 27

16

Years of Service

User Offline

Joined: 15th Feb 2008

Location:

Posted: 31st Jan 2009 17:41

Link

I updated my DBP Lock Pixels version, it's now using pitch and pointer instead of point and dot but there's still no improvements.

REM ******************************************************************
REM *                                                                *
REM *                        DBPro FloodFill                         *
REM *                                                                *
REM ******************************************************************
REM * - Ashingda27                                                   *
REM ******************************************************************

`set display mode 640,480,32
sync on
sync rate 0

REM Global Variables for FloodFill Function
global FloodWidth as integer
global FloodHeight as integer
global FloodDepth as integer
global FloodTargetColor as integer
global FloodFillColor as integer

global ScanLeftU as integer
global ScanRightU as integer

global Pitch as integer
global Pointer as integer
global Plot as integer
global color as integer

dim ScanLeftD(screen height())
dim ScanRightD(screen height())

REM Setting up for the Memblock command.
FloodWidth = bitmap width()
FloodHeight = bitmap height()
FloodDepth = bitmap depth()/8

create bitmap 1,FloodWidth,FloodHeight

REM Draws a Box with Text to be filled
ink rgb(255,255,255),0
box 320-25,240-5,320+25,240+10
ink 0,0
center text 320,240-5,"FloodFill"
ink rgb(255,255,255),0
text 0,0,"Click mouse to fill!"

line 320,10,320-100,10+100
line 320-100,10+100,320+100,10+100
line 320,10,320+100,10+100

circle 100,300,50
circle 150,350,50

box 400,300,450,350
box 500,300,550,350
line 400,325,500,325

set text opaque

REM **********************************************************************
REM Main Loop
REM **********************************************************************
do
   mc = mouseclick()
   mx = mousex()-1
   my = mousey()-1

if mc = 1
      if KeyM = 0
         REM Calling the Function
         T = Timer()
         c = rgb(rnd(255),rnd(255),rnd(255))
         FloodFill(mx,my,c)
         T = Timer()-T
      endif
      KeyM = 1
      else
      KeyM = 0
   endif

ink rgb(255,255,255),0
   text 200,0,"Speed: "+str$(T)+"   "

copy bitmap 1,0
   sync

loop

REM **********************************************************************
REM Function FloodFill
REM **********************************************************************
Function FloodFill(x as integer,y as integer,FillColor as integer)

ScanLeftU = 0
   ScanRightU = 0

REM Clear the Array
   for lp = 0 to FloodHeight
      ScanLeftD(lp) = 0
      ScanRightD(lp) = 0
   next lp

lock pixels

Pitch = get pixels pitch()
      Pointer = get pixels pointer()

REM Gets the Target Color
      Plot = Pointer + (x*FloodDepth)+(y*Pitch)
      FloodTargetColor = *Plot
      FloodFillColor = FillColor

REM Plots the first Pixel
      *Plot = FloodFillColor

REM Start the Fill Loop
      if FloodTargetColor <> FloodFillColor then FloodLoop(x,y)

unlock pixels

EndFunction

REM **********************************************************************
REM Function FloodLoop
REM **********************************************************************
Function FloodLoop(x as integer,y as integer)

local Left as integer
   local Right as integer
   local ScanY as integer

REM Left
   for Left = x-1 to 0 step -1

Plot = Pointer + (Left*FloodDepth)+(y*Pitch)
      color = *Plot

if color <> FloodTargetColor then exit

*Plot = FloodFillColor

next Left
   inc Left

REM Right
   for Right = x+1 to FloodWidth-1

Plot = Pointer + (Right*FloodDepth)+(y*Pitch)
      color = *Plot

if color <> FloodTargetColor then exit

*Plot = FloodFillColor

next Right
   dec Right

REM Move Up
   dec y
   if y > 0

for x = Left to Right

if x < ScanLeftU or x > ScanRightU

Plot = Pointer + (x*FloodDepth)+(y*Pitch)
            color = *Plot

if color = FloodTargetColor
               ScanLeftD(y) = Left
               ScanRightD(y) = Right

*Plot = FloodFillColor

FloodLoop(x,y)
            endif

else
            x = ScanRightU+1

endif

next x

endif
   inc y

ScanLeftU = Left
   ScanRightU = Right

REM Move Down
   ScanY = y
   inc y
   if y < FloodHeight-1

for x = Left to Right

if x < ScanLeftD(ScanY) or x > ScanRightD(ScanY)

Plot = Pointer + (x*FloodDepth)+(y*Pitch)
            color = *Plot

if color = FloodTargetColor

*Plot = FloodFillColor

FloodLoop(x,y)
            endif

else
            x = ScanRightD(ScanY)+1

endif

next x

endif
   dec y

if y > 0
      ScanLeftD(y-1) = Left
      ScanRightD(y-1) = Right
   endif

EndFunction

+ Code Snippet

REM ******************************************************************
REM *                                                                *
REM *                        DBPro FloodFill                         *
REM *                                                                *
REM ******************************************************************
REM * - Ashingda27                                                   *
REM ******************************************************************

`set display mode 640,480,32
sync on
sync rate 0

REM Global Variables for FloodFill Function
global FloodWidth as integer
global FloodHeight as integer
global FloodDepth as integer
global FloodTargetColor as integer
global FloodFillColor as integer

global ScanLeftU as integer
global ScanRightU as integer

global Pitch as integer
global Pointer as integer
global Plot as integer
global color as integer

dim ScanLeftD(screen height())
dim ScanRightD(screen height())

REM Setting up for the Memblock command.
FloodWidth = bitmap width()
FloodHeight = bitmap height()
FloodDepth = bitmap depth()/8

create bitmap 1,FloodWidth,FloodHeight


REM Draws a Box with Text to be filled
ink rgb(255,255,255),0
box 320-25,240-5,320+25,240+10
ink 0,0
center text 320,240-5,"FloodFill"
ink rgb(255,255,255),0
text 0,0,"Click mouse to fill!"


line 320,10,320-100,10+100
line 320-100,10+100,320+100,10+100
line 320,10,320+100,10+100

circle 100,300,50
circle 150,350,50


box 400,300,450,350
box 500,300,550,350
line 400,325,500,325

set text opaque



REM **********************************************************************
REM Main Loop
REM **********************************************************************
do
   mc = mouseclick()
   mx = mousex()-1
   my = mousey()-1

   if mc = 1
      if KeyM = 0
         REM Calling the Function
         T = Timer()
         c = rgb(rnd(255),rnd(255),rnd(255))
         FloodFill(mx,my,c)
         T = Timer()-T
      endif
      KeyM = 1
      else
      KeyM = 0
   endif

   ink rgb(255,255,255),0
   text 200,0,"Speed: "+str$(T)+"   "

   copy bitmap 1,0
   sync

loop





REM **********************************************************************
REM Function FloodFill
REM **********************************************************************
Function FloodFill(x as integer,y as integer,FillColor as integer)


   ScanLeftU = 0
   ScanRightU = 0

   REM Clear the Array
   for lp = 0 to FloodHeight
      ScanLeftD(lp) = 0
      ScanRightD(lp) = 0
   next lp

   lock pixels

      Pitch = get pixels pitch()
      Pointer = get pixels pointer()

      REM Gets the Target Color
      Plot = Pointer + (x*FloodDepth)+(y*Pitch)
      FloodTargetColor = *Plot
      FloodFillColor = FillColor

      REM Plots the first Pixel
      *Plot = FloodFillColor

      REM Start the Fill Loop
      if FloodTargetColor <> FloodFillColor then FloodLoop(x,y)

   unlock pixels

EndFunction





REM **********************************************************************
REM Function FloodLoop
REM **********************************************************************
Function FloodLoop(x as integer,y as integer)

   local Left as integer
   local Right as integer
   local ScanY as integer

   REM Left
   for Left = x-1 to 0 step -1

      Plot = Pointer + (Left*FloodDepth)+(y*Pitch)
      color = *Plot

      if color <> FloodTargetColor then exit

      *Plot = FloodFillColor

   next Left
   inc Left

   REM Right
   for Right = x+1 to FloodWidth-1

      Plot = Pointer + (Right*FloodDepth)+(y*Pitch)
      color = *Plot

      if color <> FloodTargetColor then exit

      *Plot = FloodFillColor

   next Right
   dec Right



   REM Move Up
   dec y
   if y > 0

      for x = Left to Right

         if x < ScanLeftU or x > ScanRightU

            Plot = Pointer + (x*FloodDepth)+(y*Pitch)
            color = *Plot

            if color = FloodTargetColor
               ScanLeftD(y) = Left
               ScanRightD(y) = Right

               *Plot = FloodFillColor

               FloodLoop(x,y)
            endif

            else
            x = ScanRightU+1

         endif

      next x

   endif
   inc y

   ScanLeftU = Left
   ScanRightU = Right


   REM Move Down
   ScanY = y
   inc y
   if y < FloodHeight-1

      for x = Left to Right

         if x < ScanLeftD(ScanY) or x > ScanRightD(ScanY)

            Plot = Pointer + (x*FloodDepth)+(y*Pitch)
            color = *Plot

            if color = FloodTargetColor

               *Plot = FloodFillColor

               FloodLoop(x,y)
            endif

            else
            x = ScanRightD(ScanY)+1

         endif

      next x

   endif
   dec y

   if y > 0
      ScanLeftD(y-1) = Left
      ScanRightD(y-1) = Right
   endif

EndFunction

Back to top

Profile PM Email

Green Gandalf

VIP Member

19

Years of Service

User Offline

Joined: 3rd Jan 2005

Playing: Malevolence:Sword of Ahkranox, Skyrim, Civ6.

Posted: 31st Jan 2009 19:06

Link

Works very well.

Does it need to be any faster?

One tiny criticism - I needed to change:

+ Code Snippet

   mx = mousex()-1
   my = mousey()-1

to

+ Code Snippet

   mx = mousex()
   my = mousey()

Without that change I couldn't accurately click the small features such as the centres of the letter "o"s, the dot on the "i", or the outlines of the boxes.

Back to top

Profile PM Email

Ashingda 27

16

Years of Service

User Offline

Joined: 15th Feb 2008

Location:

Posted: 31st Jan 2009 19:28 Edited at: 31st Jan 2009 19:29

Link

Thanks.

Quote: "Does it need to be any faster?"

Yes it does! Well I'm just trying to optimize it to the max, looking at the sheer speed the paint program can perform I'm sure these versions can be a bit faster than it is right now.

In DBC the -1 will make the mouseXY accurate, but you are right DBP don't need it.

Back to top

Profile PM Email

Latch

17

Years of Service

User Offline

Joined: 23rd Jul 2006

Location:

Posted: 23rd Apr 2009 01:00

Link

@Ashingda 27

I was messing around with your flood fill and came up with a couple of optimizations. Though small, they do squeeze out a little more speed. In the main fill loop, if you do the bit depth check outside of the for next loops (if FloodBytes(0)=2), it keeps the conditional from being checked every iteration. That reduces the command calls to DBC.

For some reason though, changing the Left and Right loops produces a fairly consistant speed increase. Changing All - Left Right Up and Down, produces an inconsistant speed boost. However, when it's at it's fastest, it's when all 4 direction loops have the conditional outside of the loop.

On my machine, your original code, filled the entire screen at about 410ms . The 4 loop conditional change can fill at about 310ms. The 2 loop conditional change can fill at about 326ms.
I'm sure there are other optimizations that could be done (figure out a way to eliminate the recursion). Here's both optimized versions:

left right

REM ******************************************************************
REM *                                                                *
REM *                DBClassic FloodFill Using Memblock              *
REM *                                                                *
REM ******************************************************************
REM * - Ashingda27                                                   *
REM ******************************************************************

set display mode 640,480,16
create bitmap 1,640,480
sync on
sync rate 0

REM Global Variables for FloodFill Function
dim FloodWidth(0)
dim FloodHeight(0)
dim FloodBytes(0)
dim FloodTargetColor(0)
dim FloodFillColor(0)

dim ScanLeftU(0)
dim ScanRightU(0)
dim ScanLeftD(screen height())
dim ScanRightD(screen height())

REM Setting up for the Memblock command.
FloodWidth(0) = screen width()
FloodHeight(0) = screen height()
FloodBytes(0) = screen depth()/8

REM Draws a Box with Text to be filled
ink rgb(255,255,255),0
box 320-25,240-5,320+25,240+10
ink 0,0
center text 320,240-5,"FloodFill"
ink rgb(255,255,255),0
text 0,0,"Click mouse to fill!"

line 320,10,320-100,10+100
line 320-100,10+100,320+100,10+100
line 320,10,320+100,10+100

circle 100,300,50
circle 150,350,50

box 400,300,450,350
box 500,300,550,350
line 400,325,500,325

set text opaque

REM **********************************************************************
REM Main Loop
REM **********************************************************************
do
   mc = mouseclick()
   mx = mousex()-1
   my = mousey()-1

if mc = 1
      if KeyM = 0
         REM Calling the Function
         T = Timer()
         c = rgb(rnd(255),rnd(255),rnd(255))
         FloodFill(mx,my,c)
         T = Timer()-T
      endif
      KeyM = 1
      else
      KeyM = 0
   endif

ink rgb(255,255,255),0
   text 200,0,"Speed: "+str$(T)+"   "

copy bitmap 1,0
   sync

loop

REM **********************************************************************
REM Function FloodFill
REM **********************************************************************
Function FloodFill(x,y,FillColor)

ScanLeftU(0) = 0
   ScanLeftD(y) = 0
   ScanRightU(0) = 0
   ScanRightD(y) = 0

REM Creating the Memblock from the second Bitmap.
   make memblock from bitmap 1,1

REM 16Bit Mode or 32bit mode
   if FloodBytes(0) = 2

REM Getting the FillColor
      r = (rgbr(FillColor)*63488)/255
      g = (rgbg(FillColor)*2016)/255
      b = (rgbb(FillColor)*31)/255
      FloodFillColor(0) = r | g | b
      REM Getting Target Color
      pos = 12+(x+y*FloodWidth(0))*FloodBytes(0)
      FloodTargetColor(0) = memblock word(1,pos)
      REM Fills the first Dot
      write memblock word 1,pos,FloodFillColor(0)

else

REM Getting the FillColor
      FloodFillColor(0) = FillColor
      REM Getting Target Color
      pos = 12+(x+y*FloodWidth(0))*FloodBytes(0)
      FloodTargetColor(0) = memblock dword(1,pos)
      REM Fills the first Dot
      write memblock dword 1,pos,FloodFillColor(0)

endif

REM Calling the FloodLoop
   if FloodTargetColor(0) <> FloodFillColor(0) then FloodLoop(x,y)

REM Convert to Image and paste onto screen
   make image from memblock 1,1
   paste image 1,0,0

for y = 0 to FloodHeight(0)
      ScanLeftD(y) = 0
      ScanRightD(y) = 0
   next y

EndFunction

REM **********************************************************************
REM Function FloodLoop
REM **********************************************************************
Function FloodLoop(x,y)

posY = y*FloodWidth(0)*FloodBytes(0)

REM Left
   if floodbytes(0)=2
      for Left = x-1 to 0 step -1
         pos = 12+Left*FloodBytes(0)+posY
         if memblock word(1,pos) <> FloodTargetColor(0) then exit
         write memblock word 1,pos,FloodFillColor(0)
      next Left
   else
      for Left = x-1 to 0 step -1
         pos = 12+Left*FloodBytes(0)+posY
        REM Check 16bit or 32bit
         if memblock dword(1,pos) <> FloodTargetColor(0) then exit
         write memblock dword 1,pos,FloodFillColor(0)
      next Left
   endif
   inc Left

REM Right
   if floodbytes(0)=2
      rem 16bit
      for Right = x+1 to FloodWidth(0)-1
         pos = 12+Right*FloodBytes(0)+posY
         if memblock word(1,pos) <> FloodTargetColor(0) then exit
         write memblock word 1,pos,FloodFillColor(0)
      next Right
   else
      rem 32bit
      for Right = x+1 to FloodWidth(0)-1
         pos = 12+Right*FloodBytes(0)+posY
         if memblock dword(1,pos) <> FloodTargetColor(0) then exit
         write memblock dword 1,pos,FloodFillColor(0)
      next Right
   endif
   dec Right

REM Move Up
   dec y
   posY = y*FloodWidth(0)*FloodBytes(0)

if y > 0

for x = Left to Right

if x < ScanLeftU(0) or x > ScanRightU(0)

pos = 12+x*FloodBytes(0)+posY

REM Check 16bit or 32bit
            if FloodBytes(0) = 2
               if memblock word(1,pos) = FloodTargetColor(0)
                  ScanLeftD(y) = Left
                  ScanRightD(y) = Right
                  write memblock word 1,pos,FloodFillColor(0)
                  FloodLoop(x,y)
               endif
               else
               if memblock dword(1,12+x*FloodBytes(0)+posY) = FloodTargetColor(0)
                  ScanLeftD(y) = Left
                  ScanRightD(y) = Right
                  write memblock dword 1,pos,FloodFillColor(0)
                  FloodLoop(x,y)
               endif
            endif

else
            x = ScanRightU(0)+1

endif

next x

endif
   inc y

ScanLeftU(0) = Left
   ScanRightU(0) = Right

REM Move Down
   ScanY = y
   inc y
   posY = y*FloodWidth(0)*FloodBytes(0)

if y < FloodHeight(0)-1

for x = Left to Right

if x < ScanLeftD(ScanY) or x > ScanRightD(ScanY)

pos = 12+x*FloodBytes(0)+posY

REM Check 16bit or 32bit
            if FloodBytes(0) = 2
               if memblock word(1,pos) = FloodTargetColor(0)
                  write memblock word 1,pos,FloodFillColor(0)
                  FloodLoop(x,y)
               endif
               else
               if memblock dword(1,pos) = FloodTargetColor(0)
                  write memblock dword 1,pos,FloodFillColor(0)
                  FloodLoop(x,y)
               endif
            endif

else
            x = ScanRightD(ScanY)+1

endif

next x

endif
   dec y

if y > 0
      ScanLeftD(y-1) = Left
      ScanRightD(y-1) = Right
   endif

EndFunction

+ Code Snippet

REM ******************************************************************
REM *                                                                *
REM *                DBClassic FloodFill Using Memblock              *
REM *                                                                *
REM ******************************************************************
REM * - Ashingda27                                                   *
REM ******************************************************************

set display mode 640,480,16
create bitmap 1,640,480
sync on
sync rate 0

REM Global Variables for FloodFill Function
dim FloodWidth(0)
dim FloodHeight(0)
dim FloodBytes(0)
dim FloodTargetColor(0)
dim FloodFillColor(0)

dim ScanLeftU(0)
dim ScanRightU(0)
dim ScanLeftD(screen height())
dim ScanRightD(screen height())

REM Setting up for the Memblock command.
FloodWidth(0) = screen width()
FloodHeight(0) = screen height()
FloodBytes(0) = screen depth()/8




REM Draws a Box with Text to be filled
ink rgb(255,255,255),0
box 320-25,240-5,320+25,240+10
ink 0,0
center text 320,240-5,"FloodFill"
ink rgb(255,255,255),0
text 0,0,"Click mouse to fill!"


line 320,10,320-100,10+100
line 320-100,10+100,320+100,10+100
line 320,10,320+100,10+100

circle 100,300,50
circle 150,350,50


box 400,300,450,350
box 500,300,550,350
line 400,325,500,325

set text opaque



REM **********************************************************************
REM Main Loop
REM **********************************************************************
do
   mc = mouseclick()
   mx = mousex()-1
   my = mousey()-1

   if mc = 1
      if KeyM = 0
         REM Calling the Function
         T = Timer()
         c = rgb(rnd(255),rnd(255),rnd(255))
         FloodFill(mx,my,c)
         T = Timer()-T
      endif
      KeyM = 1
      else
      KeyM = 0
   endif

   ink rgb(255,255,255),0
   text 200,0,"Speed: "+str$(T)+"   "

   copy bitmap 1,0
   sync

loop





REM **********************************************************************
REM Function FloodFill
REM **********************************************************************
Function FloodFill(x,y,FillColor)

   ScanLeftU(0) = 0
   ScanLeftD(y) = 0
   ScanRightU(0) = 0
   ScanRightD(y) = 0

   REM Creating the Memblock from the second Bitmap.
   make memblock from bitmap 1,1

   REM 16Bit Mode or 32bit mode
   if FloodBytes(0) = 2

      REM Getting the FillColor
      r = (rgbr(FillColor)*63488)/255
      g = (rgbg(FillColor)*2016)/255
      b = (rgbb(FillColor)*31)/255
      FloodFillColor(0) = r | g | b
      REM Getting Target Color
      pos = 12+(x+y*FloodWidth(0))*FloodBytes(0)
      FloodTargetColor(0) = memblock word(1,pos)
      REM Fills the first Dot
      write memblock word 1,pos,FloodFillColor(0)

      else

      REM Getting the FillColor
      FloodFillColor(0) = FillColor
      REM Getting Target Color
      pos = 12+(x+y*FloodWidth(0))*FloodBytes(0)
      FloodTargetColor(0) = memblock dword(1,pos)
      REM Fills the first Dot
      write memblock dword 1,pos,FloodFillColor(0)

   endif


   REM Calling the FloodLoop
   if FloodTargetColor(0) <> FloodFillColor(0) then FloodLoop(x,y)

   REM Convert to Image and paste onto screen
   make image from memblock 1,1
   paste image 1,0,0

   for y = 0 to FloodHeight(0)
      ScanLeftD(y) = 0
      ScanRightD(y) = 0
   next y

EndFunction





REM **********************************************************************
REM Function FloodLoop
REM **********************************************************************
Function FloodLoop(x,y)

   posY = y*FloodWidth(0)*FloodBytes(0)

   REM Left
   if floodbytes(0)=2
      for Left = x-1 to 0 step -1
         pos = 12+Left*FloodBytes(0)+posY
         if memblock word(1,pos) <> FloodTargetColor(0) then exit
         write memblock word 1,pos,FloodFillColor(0)
      next Left
   else
      for Left = x-1 to 0 step -1
         pos = 12+Left*FloodBytes(0)+posY
        REM Check 16bit or 32bit
         if memblock dword(1,pos) <> FloodTargetColor(0) then exit
         write memblock dword 1,pos,FloodFillColor(0)
      next Left
   endif
   inc Left

   REM Right
   if floodbytes(0)=2
      rem 16bit
      for Right = x+1 to FloodWidth(0)-1
         pos = 12+Right*FloodBytes(0)+posY
         if memblock word(1,pos) <> FloodTargetColor(0) then exit
         write memblock word 1,pos,FloodFillColor(0)
      next Right
   else
      rem 32bit
      for Right = x+1 to FloodWidth(0)-1
         pos = 12+Right*FloodBytes(0)+posY
         if memblock dword(1,pos) <> FloodTargetColor(0) then exit
         write memblock dword 1,pos,FloodFillColor(0)
      next Right
   endif
   dec Right

   REM Move Up
   dec y
   posY = y*FloodWidth(0)*FloodBytes(0)

   if y > 0

      for x = Left to Right

         if x < ScanLeftU(0) or x > ScanRightU(0)

            pos = 12+x*FloodBytes(0)+posY

            REM Check 16bit or 32bit
            if FloodBytes(0) = 2
               if memblock word(1,pos) = FloodTargetColor(0)
                  ScanLeftD(y) = Left
                  ScanRightD(y) = Right
                  write memblock word 1,pos,FloodFillColor(0)
                  FloodLoop(x,y)
               endif
               else
               if memblock dword(1,12+x*FloodBytes(0)+posY) = FloodTargetColor(0)
                  ScanLeftD(y) = Left
                  ScanRightD(y) = Right
                  write memblock dword 1,pos,FloodFillColor(0)
                  FloodLoop(x,y)
               endif
            endif

            else
            x = ScanRightU(0)+1

         endif

      next x

   endif
   inc y

   ScanLeftU(0) = Left
   ScanRightU(0) = Right


   REM Move Down
   ScanY = y
   inc y
   posY = y*FloodWidth(0)*FloodBytes(0)

   if y < FloodHeight(0)-1

      for x = Left to Right

         if x < ScanLeftD(ScanY) or x > ScanRightD(ScanY)

            pos = 12+x*FloodBytes(0)+posY

            REM Check 16bit or 32bit
            if FloodBytes(0) = 2
               if memblock word(1,pos) = FloodTargetColor(0)
                  write memblock word 1,pos,FloodFillColor(0)
                  FloodLoop(x,y)
               endif
               else
               if memblock dword(1,pos) = FloodTargetColor(0)
                  write memblock dword 1,pos,FloodFillColor(0)
                  FloodLoop(x,y)
               endif
            endif

            else
            x = ScanRightD(ScanY)+1

         endif

      next x

   endif
   dec y

   if y > 0
      ScanLeftD(y-1) = Left
      ScanRightD(y-1) = Right
   endif

EndFunction

left right up down

REM ******************************************************************
REM *                                                                *
REM *                DBClassic FloodFill Using Memblock              *
REM *                                                                *
REM ******************************************************************
REM * - Ashingda27                                                   *
REM ******************************************************************

set display mode 640,480,16
create bitmap 1,640,480
sync on
sync rate 0

REM Global Variables for FloodFill Function
dim FloodWidth(0)
dim FloodHeight(0)
dim FloodBytes(0)
dim FloodTargetColor(0)
dim FloodFillColor(0)

dim ScanLeftU(0)
dim ScanRightU(0)
dim ScanLeftD(screen height())
dim ScanRightD(screen height())

REM Setting up for the Memblock command.
FloodWidth(0) = screen width()
FloodHeight(0) = screen height()
FloodBytes(0) = screen depth()/8

REM Draws a Box with Text to be filled
ink rgb(255,255,255),0
box 320-25,240-5,320+25,240+10
ink 0,0
center text 320,240-5,"FloodFill"
ink rgb(255,255,255),0
text 0,0,"Click mouse to fill!"

line 320,10,320-100,10+100
line 320-100,10+100,320+100,10+100
line 320,10,320+100,10+100

circle 100,300,50
circle 150,350,50

box 400,300,450,350
box 500,300,550,350
line 400,325,500,325

set text opaque

REM **********************************************************************
REM Main Loop
REM **********************************************************************
do
   mc = mouseclick()
   mx = mousex()-1
   my = mousey()-1

if mc = 1
      if KeyM = 0
         REM Calling the Function
         T = Timer()
         c = rgb(rnd(255),rnd(255),rnd(255))
         FloodFill(mx,my,c)
         T = Timer()-T
      endif
      KeyM = 1
      else
      KeyM = 0
   endif

ink rgb(255,255,255),0
   text 200,0,"Speed: "+str$(T)+"   "

copy bitmap 1,0
   sync

loop

REM **********************************************************************
REM Function FloodFill
REM **********************************************************************
Function FloodFill(x,y,FillColor)

ScanLeftU(0) = 0
   ScanLeftD(y) = 0
   ScanRightU(0) = 0
   ScanRightD(y) = 0

REM Creating the Memblock from the second Bitmap.
   make memblock from bitmap 1,1

REM 16Bit Mode or 32bit mode
   if FloodBytes(0) = 2

REM Getting the FillColor
      r = (rgbr(FillColor)*63488)/255
      g = (rgbg(FillColor)*2016)/255
      b = (rgbb(FillColor)*31)/255
      FloodFillColor(0) = r | g | b
      REM Getting Target Color
      pos = 12+(x+y*FloodWidth(0))*FloodBytes(0)
      FloodTargetColor(0) = memblock word(1,pos)
      REM Fills the first Dot
      write memblock word 1,pos,FloodFillColor(0)

else

REM Getting the FillColor
      FloodFillColor(0) = FillColor
      REM Getting Target Color
      pos = 12+(x+y*FloodWidth(0))*FloodBytes(0)
      FloodTargetColor(0) = memblock dword(1,pos)
      REM Fills the first Dot
      write memblock dword 1,pos,FloodFillColor(0)

endif

REM Calling the FloodLoop
   if FloodTargetColor(0) <> FloodFillColor(0) then FloodLoop(x,y)

REM Convert to Image and paste onto screen
   make image from memblock 1,1
   paste image 1,0,0

for y = 0 to FloodHeight(0)
      ScanLeftD(y) = 0
      ScanRightD(y) = 0
   next y

EndFunction

REM **********************************************************************
REM Function FloodLoop
REM **********************************************************************
Function FloodLoop(x,y)

posY = y*FloodWidth(0)*FloodBytes(0)

REM Left
   if floodbytes(0)=2
      for Left = x-1 to 0 step -1
         pos = 12+Left*FloodBytes(0)+posY
         if memblock word(1,pos) <> FloodTargetColor(0) then exit
         write memblock word 1,pos,FloodFillColor(0)
      next Left
   else
      for Left = x-1 to 0 step -1
         pos = 12+Left*FloodBytes(0)+posY
        REM Check 16bit or 32bit
         if memblock dword(1,pos) <> FloodTargetColor(0) then exit
         write memblock dword 1,pos,FloodFillColor(0)
      next Left
   endif
   inc Left

REM Right
   if floodbytes(0)=2
      rem 16bit
      for Right = x+1 to FloodWidth(0)-1
         pos = 12+Right*FloodBytes(0)+posY
         if memblock word(1,pos) <> FloodTargetColor(0) then exit
         write memblock word 1,pos,FloodFillColor(0)
      next Right
   else
      rem 32bit
      for Right = x+1 to FloodWidth(0)-1
         pos = 12+Right*FloodBytes(0)+posY
         if memblock dword(1,pos) <> FloodTargetColor(0) then exit
         write memblock dword 1,pos,FloodFillColor(0)
      next Right
   endif
   dec Right

REM Move Up
   dec y
   posY = y*FloodWidth(0)*FloodBytes(0)

if y > 0

if FloodBytes(0)=2
         rem 16bit
         for x = Left to Right

if x < ScanLeftU(0) or x > ScanRightU(0)

pos = 12+x*FloodBytes(0)+posY

if memblock word(1,pos) = FloodTargetColor(0)
                  ScanLeftD(y) = Left
                  ScanRightD(y) = Right
                  write memblock word 1,pos,FloodFillColor(0)
                  FloodLoop(x,y)
               endif

else
               x = ScanRightU(0)+1

endif

next x
      else
         rem 32bit
         for x = Left to Right

if x < ScanLeftU(0) or x > ScanRightU(0)

pos = 12+x*FloodBytes(0)+posY

if memblock dword(1,pos) = FloodTargetColor(0)
                  ScanLeftD(y) = Left
                  ScanRightD(y) = Right
                  write memblock dword 1,pos,FloodFillColor(0)
                  FloodLoop(x,y)
               endif

else
               x = ScanRightU(0)+1

endif

next x
      endif

endif
   inc y

ScanLeftU(0) = Left
   ScanRightU(0) = Right

REM Move Down
   ScanY = y
   inc y
   posY = y*FloodWidth(0)*FloodBytes(0)

if y < FloodHeight(0)-1
      if FloodBytes(0)=2
         for x = Left to Right

if x < ScanLeftD(ScanY) or x > ScanRightD(ScanY)

pos = 12+x*FloodBytes(0)+posY

if memblock word(1,pos) = FloodTargetColor(0)
                  write memblock word 1,pos,FloodFillColor(0)
                  FloodLoop(x,y)
               endif

else
               x = ScanRightD(ScanY)+1
            endif

next x
      else
         for x = Left to Right

if x < ScanLeftD(ScanY) or x > ScanRightD(ScanY)

pos = 12+x*FloodBytes(0)+posY

if memblock word(1,pos) = FloodTargetColor(0)
                  write memblock word 1,pos,FloodFillColor(0)
                  FloodLoop(x,y)
               endif

else
               x = ScanRightD(ScanY)+1
            endif

next x
      endif
   endif
   dec y

if y > 0
      ScanLeftD(y-1) = Left
      ScanRightD(y-1) = Right
   endif

EndFunction

+ Code Snippet

REM ******************************************************************
REM *                                                                *
REM *                DBClassic FloodFill Using Memblock              *
REM *                                                                *
REM ******************************************************************
REM * - Ashingda27                                                   *
REM ******************************************************************

set display mode 640,480,16
create bitmap 1,640,480
sync on
sync rate 0

REM Global Variables for FloodFill Function
dim FloodWidth(0)
dim FloodHeight(0)
dim FloodBytes(0)
dim FloodTargetColor(0)
dim FloodFillColor(0)

dim ScanLeftU(0)
dim ScanRightU(0)
dim ScanLeftD(screen height())
dim ScanRightD(screen height())

REM Setting up for the Memblock command.
FloodWidth(0) = screen width()
FloodHeight(0) = screen height()
FloodBytes(0) = screen depth()/8




REM Draws a Box with Text to be filled
ink rgb(255,255,255),0
box 320-25,240-5,320+25,240+10
ink 0,0
center text 320,240-5,"FloodFill"
ink rgb(255,255,255),0
text 0,0,"Click mouse to fill!"


line 320,10,320-100,10+100
line 320-100,10+100,320+100,10+100
line 320,10,320+100,10+100

circle 100,300,50
circle 150,350,50


box 400,300,450,350
box 500,300,550,350
line 400,325,500,325

set text opaque



REM **********************************************************************
REM Main Loop
REM **********************************************************************
do
   mc = mouseclick()
   mx = mousex()-1
   my = mousey()-1

   if mc = 1
      if KeyM = 0
         REM Calling the Function
         T = Timer()
         c = rgb(rnd(255),rnd(255),rnd(255))
         FloodFill(mx,my,c)
         T = Timer()-T
      endif
      KeyM = 1
      else
      KeyM = 0
   endif

   ink rgb(255,255,255),0
   text 200,0,"Speed: "+str$(T)+"   "

   copy bitmap 1,0
   sync

loop


REM **********************************************************************
REM Function FloodFill
REM **********************************************************************
Function FloodFill(x,y,FillColor)

   ScanLeftU(0) = 0
   ScanLeftD(y) = 0
   ScanRightU(0) = 0
   ScanRightD(y) = 0

   REM Creating the Memblock from the second Bitmap.
   make memblock from bitmap 1,1

   REM 16Bit Mode or 32bit mode
   if FloodBytes(0) = 2

      REM Getting the FillColor
      r = (rgbr(FillColor)*63488)/255
      g = (rgbg(FillColor)*2016)/255
      b = (rgbb(FillColor)*31)/255
      FloodFillColor(0) = r | g | b
      REM Getting Target Color
      pos = 12+(x+y*FloodWidth(0))*FloodBytes(0)
      FloodTargetColor(0) = memblock word(1,pos)
      REM Fills the first Dot
      write memblock word 1,pos,FloodFillColor(0)

      else

      REM Getting the FillColor
      FloodFillColor(0) = FillColor
      REM Getting Target Color
      pos = 12+(x+y*FloodWidth(0))*FloodBytes(0)
      FloodTargetColor(0) = memblock dword(1,pos)
      REM Fills the first Dot
      write memblock dword 1,pos,FloodFillColor(0)

   endif


   REM Calling the FloodLoop
   if FloodTargetColor(0) <> FloodFillColor(0) then FloodLoop(x,y)

   REM Convert to Image and paste onto screen
   make image from memblock 1,1
   paste image 1,0,0

   for y = 0 to FloodHeight(0)
      ScanLeftD(y) = 0
      ScanRightD(y) = 0
   next y

EndFunction





REM **********************************************************************
REM Function FloodLoop
REM **********************************************************************
Function FloodLoop(x,y)

   posY = y*FloodWidth(0)*FloodBytes(0)

   REM Left
   if floodbytes(0)=2
      for Left = x-1 to 0 step -1
         pos = 12+Left*FloodBytes(0)+posY
         if memblock word(1,pos) <> FloodTargetColor(0) then exit
         write memblock word 1,pos,FloodFillColor(0)
      next Left
   else
      for Left = x-1 to 0 step -1
         pos = 12+Left*FloodBytes(0)+posY
        REM Check 16bit or 32bit
         if memblock dword(1,pos) <> FloodTargetColor(0) then exit
         write memblock dword 1,pos,FloodFillColor(0)
      next Left
   endif
   inc Left

   REM Right
   if floodbytes(0)=2
      rem 16bit
      for Right = x+1 to FloodWidth(0)-1
         pos = 12+Right*FloodBytes(0)+posY
         if memblock word(1,pos) <> FloodTargetColor(0) then exit
         write memblock word 1,pos,FloodFillColor(0)
      next Right
   else
      rem 32bit
      for Right = x+1 to FloodWidth(0)-1
         pos = 12+Right*FloodBytes(0)+posY
         if memblock dword(1,pos) <> FloodTargetColor(0) then exit
         write memblock dword 1,pos,FloodFillColor(0)
      next Right
   endif
   dec Right

   REM Move Up
   dec y
   posY = y*FloodWidth(0)*FloodBytes(0)

   if y > 0

      if FloodBytes(0)=2
         rem 16bit
         for x = Left to Right

            if x < ScanLeftU(0) or x > ScanRightU(0)

               pos = 12+x*FloodBytes(0)+posY

               if memblock word(1,pos) = FloodTargetColor(0)
                  ScanLeftD(y) = Left
                  ScanRightD(y) = Right
                  write memblock word 1,pos,FloodFillColor(0)
                  FloodLoop(x,y)
               endif

            else
               x = ScanRightU(0)+1

            endif

         next x
      else
         rem 32bit
         for x = Left to Right

            if x < ScanLeftU(0) or x > ScanRightU(0)

               pos = 12+x*FloodBytes(0)+posY

               if memblock dword(1,pos) = FloodTargetColor(0)
                  ScanLeftD(y) = Left
                  ScanRightD(y) = Right
                  write memblock dword 1,pos,FloodFillColor(0)
                  FloodLoop(x,y)
               endif

            else
               x = ScanRightU(0)+1

            endif

         next x
      endif

   endif
   inc y

   ScanLeftU(0) = Left
   ScanRightU(0) = Right


   REM Move Down
   ScanY = y
   inc y
   posY = y*FloodWidth(0)*FloodBytes(0)

   if y < FloodHeight(0)-1
      if FloodBytes(0)=2
         for x = Left to Right

            if x < ScanLeftD(ScanY) or x > ScanRightD(ScanY)

               pos = 12+x*FloodBytes(0)+posY

               if memblock word(1,pos) = FloodTargetColor(0)
                  write memblock word 1,pos,FloodFillColor(0)
                  FloodLoop(x,y)
               endif

            else
               x = ScanRightD(ScanY)+1
            endif

         next x
      else
         for x = Left to Right

            if x < ScanLeftD(ScanY) or x > ScanRightD(ScanY)

               pos = 12+x*FloodBytes(0)+posY

               if memblock word(1,pos) = FloodTargetColor(0)
                  write memblock word 1,pos,FloodFillColor(0)
                  FloodLoop(x,y)
               endif

            else
               x = ScanRightD(ScanY)+1
            endif

         next x
      endif
   endif
   dec y

   if y > 0
      ScanLeftD(y-1) = Left
      ScanRightD(y-1) = Right
   endif

EndFunction

Also, I get an Array Accessed out of Bounds error if I move the mouse to the upper right corner and click.

Enjoy your day.

Back to top

Profile PM

Sorry your browser is not supported!

Code Snippets / [DBC] Flood Fill using Memblock

Attachments