REM Project: Draw_and_fill_program
`Draw program by Mark
` Fill program by Ian_M
startgameover:
set display mode 1024,768,16
sync on
sync rate 0
rem beggining rgb values
r = 255:g = 0:b
= 0
`beggining line value in printit
l = 60
rem draw a rainbow color pallet on left side of screen:
do
g = g + 5: if g = 255 then goto two
gosub printit
loop
do
two:
r = r - 5: if r = 0 then goto three
gosub printit
loop
do
three:
b = b + 5: if b = 255 then goto four
gosub printit
loop
do
four:
g = g - 5: if g = 0 then goto five
gosub printit
loop
do
five:
r = r + 5: if r = 255 then goto six
gosub printit
loop
do
six:
b = b - 5: if b = 0 then goto paintingpart
gosub printit
loop
printit:
inc l: ink rgb(r,g,b),0
line 0,l,20,l:inc l:line 0,l,20,l
return
rem ------------------painting program part-------------------
rem Determine color of a pixel
paintingpart: sync
text 400,710, "Draw and select pallet color with left mouse button"
text
400,725, "Fill with right mouse button"
text 400,740, "New game with middle mouse button"
text 400,755, "Save
an image with right and left mouse button"
rem set cursor 400,755: print "fill with right mouse button"
red = r:green
= g:b = blue
`-------------------------------------------------
do
rem find out where mouse is:
mc = mouseclick(): mx = mousex(): my =
mousey()
rem find out if left mouse button is being pressed:
if mc = 1 and mx
<20 then gosub getnewcolor : mc1my1flag = 0
if mc = 1 and mc1my1flag = 0 then dot mx,my
if mc = 1 and mc1my1flag
= 1 then line mx1,my1,mx,my
rem save variables to draw next mouse-line:
mx1 = mx: my1 = my:mc1my1flag
= 1
rem find out if middle mouse button is pressed:
if mc = 4 then goto
startgameover
rem if mc = 3 then save bitmap "c:painting.bmp"
` or if right mouse
button being pushed:
if mc = 2 and mx > 20 then floodfill(mx,my,red,green,blue)
if mc = 3 `(left and right mouse
button)
get image 1,0,0,1023,767,1: save image "Draw_Fill.jpg",1
endif
sync
loop
`-------------------------- get new color ------------------
getnewcolor:
rem find out what color of the pallet is being pressed:
colorvalue=point(mx,my)
red=rgbr(colorvalue)
green=rgbg(colorvalue)
blue=rgbb(colorvalue)
rem Set the ink color
ink rgb(red,green,blue),0
return
end
Rem *** Include File: FloodfillFunction.dba ***
Rem Created: 30.7.2005
10:53:21
Rem Included in Project: C:Program FilesThe Game CreatorsDark Basic ProfessionalProjectsPaint
program Mark'sPaint program Mark's.dbpro
`--------------------- Function "floodfill"-----------------------------------------------
`
to call floodfill all you need is x,y screenposition and the rgb color
` the protocol is very simple, an example would
be:
` x = 75: y = 200: r = 255: g = 125: b = 10: floodfill(x,y,r,g,b)
` that's it! it's very easy.
type __FloodFillType
Initialised as integer
CoverColour as integer
BitmapWidth as integer
BitmapHeight as integer
endtype
global
__FloodFillGlobal as __FloodFillType
#constant __SpanListSize 500
type __FillSpan
Left as
integer
Right as integer
endtype
global dim __FilledSpans() as __FillSpan
global dim __FilledSpansCount()
as integer
function FloodFill(x,y,r,g,b)
__FloodFillGlobal.BitmapWidth=bitmap width()-1
__FloodFillGlobal.BitmapHeight=bitmap height()-1
__InitialiseFillSpan()
if x >= 0 or x <= __FloodFillGlobal.BitmapWidth
if y >= 0 or y <= __FloodFillGlobal.BitmapHeight
lock pixels
__FloodFillGlobal.CoverColour
= point(x,y)
if __FloodFillGlobal.CoverColour
<> c
ink
c,0
__FloodLoop(x,y,r,g,b)
endif
unlock pixels
endif
endif
endfunction
function __FloodLoop(x as integer,y as integer,r,g,b)
local
Left as integer
local Right as integer
local SpanSize as integer
for Left=x-1 to 0 step -1
if point(Left,y) <> __FloodFillGlobal.CoverColour then exit
next Left
inc Left
for Right=x+1 to __FloodFillGlobal.BitmapWidth
if point(Right,y) <> __FloodFillGlobal.CoverColour then exit
next Right
`*************************************************************************
`++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
` draw this line
ink rgb(r,g,b),0:rem line Left,y,Right,y
dotline(Left,y,Right)
` and remember it
__AddFillSpan(y,Left-1,Right+1)
` Fill upwards
if y > 0
dec y
x=Left
while x < Right
SpanSize=__CheckFillSpan(x,y)
if SpanSize = 0
if point(x,y) = __FloodFillGlobal.CoverColour
__FloodLoop(x,y,r,g,b)
endif
inc x
else
inc x,SpanSize
endif
endwhile
inc y
endif
` Fill downwards
if y < __FloodFillGlobal.BitmapHeight
inc y
x=Left
while x < Right
SpanSize=__CheckFillSpan(x,y)
if SpanSize = 0
if point(x,y) = __FloodFillGlobal.CoverColour
__FloodLoop(x,y,r,g,b)
endif
inc x
else
inc x,SpanSize
endif
endwhile
endif
endfunction
function __InitialiseFillSpan()
local i as integer
if __FloodFillGlobal.Initialised = 0
` First time called, create the arrays -
bigger than we should ever need
undim __FilledSpans()
global dim __FilledSpans(__SpanListSize,2048) as __FillSpan
undim __FilledSpansCount()
global dim __FilledSpansCount(2048) as integer
__FloodFillGlobal.Initialised=1
else
` Subsequent call, just reset the spans
we'll be using
for i=__FloodFillGlobal.BitmapHeight to 0 step -1
__FilledSpansCount(i)=0
next i
endif
endfunction
function __AddFillSpan(y as integer,Left as integer,Right as integer)
local i as integer
i=__FilledSpansCount(y)
if i < __SpanListSize
__FilledSpans(i, y).Left=Left
__FilledSpans(i, y).Right=Right
inc __FilledSpansCount(y)
endif
endfunction
function __CheckFillSpan(x as integer,y as integer)
local i as integer
for i=__FilledSpansCount(y)-1 to 0 step -1
if x >= __FilledSpans(i, y).Left
if x < __FilledSpans(i, y).Right
then exitfunction __FilledSpans(i, y).Right-x
endif
next i
endfunction
0
function dotline(Left as integer,y as integer,Right as integer)
L99 = Left
bubba:
dot L99,y: inc L99: if L99 = Right then goto bubba1
goto bubba
bubba1:
endfunction
