These easy to use functions allow images to be created using memblocks within dark basic pro code. This can be used to create your own images and to edit loaded images.

The shapes included are:
-dot
-line
-circle (not filled)
-box (filled)

The top left pixel of an image memblock is (1,1) when working with these functions. The bottom right is therefore (width,height). Although memblocks allow transparency to be edited, this is ignored in my functions.

The necessary code is below the remark "functions". Everything above is just an example.

Language: 
Dark Basic Pro
Code: 
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#
3
Average: 3 (1 vote)