| Ad_Infinitum |
| Administrator |
 |
 |
| Data inscrierii: 23/Iun/2007 |
| Mesaje: 212 |
|
|
|
|
|
 |
|
sync on
sync rate 0
set text font "Arial"
set text size 16
set image colorkey 0,255,255
randomize timer()
#Constant TRUE 1
#Constant FALSE 0
make_image_memblock(1,512,512,32)
memblock_box(1,1,1,512,512,rgb(0,0,0))
mode=1
gosub example_update
do
sync
i=val(inkey$())
if i>0 and i<6
mode=i
update=TRUE
if mode=5
memblock_box(1,1,1,512,512,rgb(0,0,0))
mode=1
endif
endif
px=mx
py=my
mx=mousex()
my=mousey()
if mouseclick()=TRUE
if mx<512 and my<512 and mx>0 and my>0
select mode
case 1
memblock_dot(1,mx,my,rgb(rnd(255),rnd(255),rnd(255)))
endcase
case 2
memblock_line(1,px,py,mx,my,rgb(rnd(255),rnd(255),rnd(255)))
endcase
case 3
memblock_circle(1,mx,my,rnd(24)+1,rgb(rnd(255),rnd(255),rnd(255)))
endcase
case 4
memblock_box(1,px,py,mx,my,rgb(rnd(255),rnd(255),rnd(255)))
endcase
case default
exit prompt "Drawing mode does not exist.","Error!"
end
endcase
endselect
update=TRUE
endif
endif
if update=TRUE
gosub example_update
endif
loop
end
example_update:
cls 0
make image from memblock 1,1
ink -1,0
box 0,0,520,520
paste image 1,0,0,0
text 530,0,"1) Draw Dot"
text 530,20,"2) Draw Line"
text 530,40,"3) Draw Circle"
text 530,60,"4) Draw Box"
text 530,80,"5} Clear Drawing"
text 530,100,"Current Mode "+str$(mode)
update=FALSE
return
`Functions:
`---------------------------------------------------------------------------------
`Create a memblock which will be used for images
`---------------------------------------------------------------------------------
function make_image_memblock(memblock,width,height,depth)
make memblock memblock,width*height*depth*4+12
write memblock dword memblock,0,width
write memblock dword memblock,4,height
write memblock dword memblock,8,depth
endfunction
`---------------------------------------------------------------------------------
`Change a pixel in an image memblock to a specified color
`---------------------------------------------------------------------------------
function memblock_dot(memblock,xcoord,ycoord,colour as dword)
width=memblock dword(memblock,0)
write memblock dword memblock,((ycoord-1)*width+xcoord-1)*4+12,colour
endfunction
`---------------------------------------------------------------------------------
`Change a line of pixels in an image memblock to a specified color
`---------------------------------------------------------------------------------
function memblock_line(memblock,x1,y1,x2,y2,colour as dword)
width=memblock dword(memblock,0)
if abs(x2-x1)>abs(y2-y1)
m#=(y2-y1+0.0)/(x2-x1+0.0)
b#=y1-m#*x1
minx=min(x1,x2)
maxx=max(x1,x2)
for ix=minx to maxx
iy=int(m#*ix+b#+0.5)
write memblock dword memblock,((iy-1)*width+ix-1)*4+12,colour
next ix
else
miny=min(y1,y2)
maxy=max(y1,y2)
if x2=x1
for iy=miny to maxy
write memblock dword memblock,((iy-1)*width+x1-1)*4+12,colour
next iy
else
m#=(x2-x1+0.0)/(y2-y1+0.0)
b#=y1-1/m#*x1
for iy=miny to maxy
ix=int(m#*(iy-b#)+0.5)
write memblock dword memblock,((iy-1)*width+ix-1)*4+12,colour
next ix
endif
endif
endfunction
`---------------------------------------------------------------------------------
`Change a box of pixels in an image memblock to a specified color
`---------------------------------------------------------------------------------
function memblock_box(memblock,left,top,right,bottom,colour as dword)
width=memblock dword(memblock,0)
minx=min(left,right)
maxx=max(left,right)
miny=min(top,bottom)
maxy=max(top,bottom)
for x=minx to maxx
for y=miny to maxy
memblock_dot(memblock,x,y,colour)
next y
next x
endfunction
`---------------------------------------------------------------------------------
`Creates a circle of pixels in an image memblock to a specified color
`---------------------------------------------------------------------------------
function memblock_circle(memblock,centerx,centery,radius,colour as dword)
bx=centerx-radius
py1=centery+sqrt(radius^2-(bx-centerx)^2)
py2=centery-sqrt(radius^2-(bx-centerx)^2)
ex=centerx+radius
width=memblock dword(memblock,0)
size=get memblock size(1)
for x=bx to ex
y1=centery+sqrt(radius^2-(x-centerx)^2)
y2=centery-sqrt(radius^2-(x-centerx)^2)
miny=min(py1,y1)
maxy=max(py1,y1)
for y=miny to maxy
pos=((y-1)*width+x-1)*4+12
if pos>11 and pos<size
write memblock dword memblock,pos,colour
endif
next y
miny=min(py2,y2)
maxy=max(py2,y2)
for y=miny to maxy
pos=((y-1)*width+x-1)*4+12
if pos>11 and pos<size
write memblock dword memblock,pos,colour
endif
next y
py1=y1
py2=y2
next x
endfunction
`---------------------------------------------------------------------------------
`Returns the minimum of two values
`---------------------------------------------------------------------------------
function min(value1#,value2#)
if value1#<value2#
a#=value1#
else
a#=value2#
endif
endfunction a#
`---------------------------------------------------------------------------------
`Returns the maximum of two values
`---------------------------------------------------------------------------------
function max(value1#,value2#)
if value1#>value2#
a#=value1#
else
a#=value2#
endif
endfunction a#
------------------------------ScreenShot----------------------------------
 |
|
