Hello everyone.
As many others, I used to know nothing about memblocks. Since recently, I started diving into the memblock techniques. A couple of weeks ago, I completed a set of functions, that I thought I'd share to the community.
The functions are:
TransImageMemblocks(mem1,mem2,RetMem,TransColor,Range)
mem1 = the top memblock.
mem2 = the bottom memblock.
RetMem = the returned memblock that will be created.
TransColor = the color that should be transparent.
Range = The range that the transparent color can range in.
TransMapImageMemblocks(mem1,map,RetMem)
mem1 = the memblock that has to be edited.
map = the memblock image that contains the greyscales for the transparency.
RetMem = the returned memblock that will be created.
BlendImageMemblocks(mem1,mem2,RetMem, percentage#)
mem1 = the first memblock image.
mem2 = the second memblock image.
RetMem = the returned memblock that will be created.
percentage# = 0 will display the first memblock completely, 100 the second. If you give 50, the returned memblock will be a faded effect.
BlendImageMemblocks(mem1,mem2,RetMem,Map)
mem1 = the top memblock image.
mem2 = the bottom memblock image.
RetMem = the returned memblock that will be created.
Map = the memblock containing the greyscales for blending the images.
This function does the same as a program called ImageTrans
Note: These functions require equally sized memblock images. If the images are not sized equally, an error might occur. To prevent this, use the ResizeImage function:
ResizeImage(nr, FreeMem, NewX, NewY)
nr = the current image number(this has to be a free memblock number!).
FreeMem = the memblock number that is used for temporary data.
--> All memblocks are deleted automatically, the image nr stays.
NewX,NewY = the new size of the image.
And, ofcourse, the code:
function BlendMapImageMemblocks(Mem1, Mem2, RetMem, Map)
`Get data
Width = memblock dword(Mem1, 0)
Height = memblock dword(Mem1, 4)
`setup teh returned memblock
if memblock exist(RetMem)=0 then make memblock RetMem, 12 + (Width*Height*4)
write memblock dword RetMem, 0, Width
write memblock dword RetMem, 4, Height
write memblock dword RetMem, 8, 32
`blend
for y = 1 to Height
for x = 1 to Width
pos = 12 + ((y-1)*Width*4) + ((x-1)*4)
difblue# = (memblock byte(Mem2, pos) - memblock byte(Mem1, pos))
difgreen# = (memblock byte(Mem2, pos+1) - memblock byte(Mem1, pos+1))
difred# = (memblock byte(Mem2, pos+2) - memblock byte(Mem1, pos+2))
blue = memblock byte(Mem1, pos) + int(difblue# / 255.0 * memblock byte(Map, pos))
green = memblock byte(Mem1, pos+1) + int(difgreen#/ 255.0 * memblock byte(Map, pos+1))
red = memblock byte(Mem1, pos+2) + int(difred# / 255.0 * memblock byte(Map, pos+2))
write memblock byte RetMem, pos, blue
write memblock byte RetMem, pos+1, green
write memblock byte RetMem, pos+2, red
write memblock byte RetMem, pos+3, 255
next x
next y
endfunction
function TransImageMemblocks(Mem1, Mem2, RetMem, transcolor, range)
`Get data
Width = memblock dword(Mem1, 0)
Height = memblock dword(Mem1, 4)
`setup the returned memblock
if memblock exist(RetMem) = 0 then make memblock RetMem, 12 + (Width*Height*4)
write memblock dword RetMem, 0, Width
write memblock dword RetMem, 4, Height
write memblock dword RetMem, 8, 32
`Calculate the memblock
red = rgbr(transcolor) : green = rgbg(transcolor) : blue = rgbb(transcolor)
for y = 1 to Height
for x = 1 to Width
pos = 12 + ((y-1)*Width*4) + ((x-1)*4)
Iblue = memblock byte(Mem1, pos)
Igreen = memblock byte(Mem1, pos+1)
Ired = memblock byte(Mem1, pos+3)
if red < Ired+range and red > Ired-range and green > Igreen-range and green < Igreen+range and blue > Iblue-range and blue < Iblue+range
write memblock byte RetMem, pos, memblock byte(Mem2, pos)
write memblock byte RetMem, pos+1, memblock byte(Mem2, pos+1)
write memblock byte RetMem, pos+2, memblock byte(Mem2, pos+2)
write memblock byte RetMem, pos+3, 255
else
copy memblock Mem1, RetMem, pos, pos, 4
endif
next x
next y
endfunction
function BlendImageMemblocks(Mem1, Mem2, RetMem, percent#)
`Get data
Width = memblock dword(Mem1, 0)
Height = memblock dword(Mem1, 4)
`setup teh returned memblock
if memblock exist(RetMem)=0 then make memblock RetMem, 12 + (Width*Height*4)
write memblock dword RetMem, 0, Width
write memblock dword RetMem, 4, Height
write memblock dword RetMem, 8, 32
`blend
for y = 1 to Height
for x = 1 to Width
pos = 12 + ((y-1)*Width*4) + ((x-1)*4)
difblue# = (memblock byte(Mem2, pos) - memblock byte(Mem1, pos))
difgreen# = (memblock byte(Mem2, pos+1) - memblock byte(Mem1, pos+1))
difred# = (memblock byte(Mem2, pos+2) - memblock byte(Mem1, pos+2))
blue = memblock byte(Mem1, pos) + int(difblue# / 100.0 * percent#)
green = memblock byte(Mem1, pos+1) + int(difgreen#/ 100.0 * percent#)
red = memblock byte(Mem1, pos+2) + int(difred# / 100.0 * percent#)
write memblock byte RetMem, pos, blue
write memblock byte RetMem, pos+1, green
write memblock byte RetMem, pos+2, red
write memblock byte RetMem, pos+3, 255
next x
next y
endfunction
function TransMapImageMemblocks(Mem, Map, RetMem)
`Get data
Width = memblock dword(Mem, 0)
Height = memblock dword(Mem, 4)
`Create memblock
if memblock exist(RetMem) = 0 then make memblock RetMem, 12 + (Width*Height*4)
write memblock dword RetMem, 0, Width
write memblock dword RetMem, 4, Height
write memblock dword RetMem, 8, 32
`calculate memblock
for y = 1 to Height
for x = 1 to Width
pos = 12 + ((y-1)*Width*4) + ((x-1)*4)
blue = memblock byte(Mem, pos) / 255.0 * memblock byte(Map, pos)
green = memblock byte(Mem, pos + 1) / 255.0 * memblock byte(Map, pos + 1)
red = memblock byte(Mem, pos + 2) / 255.0 * memblock byte(Map, pos + 2)
write memblock byte RetMem, pos, blue
write memblock byte RetMem, pos+1, green
write memblock byte RetMem, pos+2, red
write memblock byte RetMem, pos+3, 255
next x
next y
endfunction
function ResizeImage(nr, freeMem, newX, newY)
`for data
make memblock from image nr ,nr
width# = memblock dword(nr, 0)
height# = memblock dword(nr, 4)
`make new image memblock
make memblock freeMem, 12 + (newX * newY * 4)
write memblock dword freeMem, 0, newX
write memblock dword freeMem, 4, newY
write memblock dword freeMem, 8, 32
`Start copying data
for y = 1 to newY
for x = 1 to newX
`Get positions
Ox = int(width#/newX*(x-1))
Oy = int(height#/newY*(y-1))
Opos = 12 + (Oy*int(width#)*4) + (Ox*4)
pos = 12 + ((y-1)*newX*4) + ((x-1)*4)
`Copy data
copy memblock nr, freeMem, Opos, pos, 4
next x
next y
`Transform into images
make image from memblock nr, freeMem
delete memblock freeMem
delete memblock nr
endfunction
---
An example of the BlendImageMemblocks and TransImageMemblocks:
sync on : sync rate 100
`Create text: white on black
cls
set text size 50
set text font "Comic Sans MS"
text 0,0,"Example"
get image 1,0,0,text width("Example"), text height("Example"), 1
`Create a background image
box 0,0,text width("Example"), text height("Example"), rgb(255,0,0),rgb(0,255,0),rgb(0,0,255),rgb(255,255,255)
get image 2,0,0,text width("Example"), text height("Example"), 1
`Convert to memblocks
make memblock from image 1,1
make memblock from image 2,2
`Make a third, transparent memblock
TransImageMemblocks(1,2,3,rgb(255,255,255), 5)
`Convert to an image
make image from memblock 3,3
`Create a first blended image
BlendImageMemblocks(1,2,4,0)
make image from memblock 4,4
percent = 0
do
`The example of the TransImageMemblocks
cls
paste image 1,0,0
paste image 2,0,50
paste image 3,0,100
`The example of BlendImageMemblocks
if upkey() = 1 then inc percent
if downkey() = 1 then dec percent
if percent < 0 then percent = 0
if percent > 100 then percent = 100
if upkey() + downkey() > 0
delete memblock 4
BlendImageMemblocks(1,2,4,percent)
make image from memblock 4,4
endif
paste image 1,320,0
paste image 2,320,50
paste image 4,320,100
sync
loop
`The functions
function TransImageMemblocks(Mem1, Mem2, RetMem, transcolor, range)
`Get data
Width = memblock dword(Mem1, 0)
Height = memblock dword(Mem1, 4)
`setup the returned memblock
if memblock exist(RetMem) = 0 then make memblock RetMem, 12 + (Width*Height*4)
write memblock dword RetMem, 0, Width
write memblock dword RetMem, 4, Height
write memblock dword RetMem, 8, 32
`Calculate the memblock
red = rgbr(transcolor) : green = rgbg(transcolor) : blue = rgbb(transcolor)
for y = 1 to Height
for x = 1 to Width
pos = 12 + ((y-1)*Width*4) + ((x-1)*4)
Iblue = memblock byte(Mem1, pos)
Igreen = memblock byte(Mem1, pos+1)
Ired = memblock byte(Mem1, pos+3)
if red < Ired+range and red > Ired-range and green > Igreen-range and green < Igreen+range and blue > Iblue-range and blue < Iblue+range
write memblock byte RetMem, pos, memblock byte(Mem2, pos)
write memblock byte RetMem, pos+1, memblock byte(Mem2, pos+1)
write memblock byte RetMem, pos+2, memblock byte(Mem2, pos+2)
write memblock byte RetMem, pos+3, 255
else
copy memblock Mem1, RetMem, pos, pos, 4
endif
next x
next y
endfunction
function BlendImageMemblocks(Mem1, Mem2, RetMem, percent#)
`Get data
Width = memblock dword(Mem1, 0)
Height = memblock dword(Mem1, 4)
`setup teh returned memblock
if memblock exist(RetMem)=0 then make memblock RetMem, 12 + (Width*Height*4)
write memblock dword RetMem, 0, Width
write memblock dword RetMem, 4, Height
write memblock dword RetMem, 8, 32
`blend
for y = 1 to Height
for x = 1 to Width
pos = 12 + ((y-1)*Width*4) + ((x-1)*4)
difblue# = (memblock byte(Mem2, pos) - memblock byte(Mem1, pos))
difgreen# = (memblock byte(Mem2, pos+1) - memblock byte(Mem1, pos+1))
difred# = (memblock byte(Mem2, pos+2) - memblock byte(Mem1, pos+2))
blue = memblock byte(Mem1, pos) + int(difblue# / 100.0 * percent#)
green = memblock byte(Mem1, pos+1) + int(difgreen#/ 100.0 * percent#)
red = memblock byte(Mem1, pos+2) + int(difred# / 100.0 * percent#)
write memblock byte RetMem, pos, blue
write memblock byte RetMem, pos+1, green
write memblock byte RetMem, pos+2, red
write memblock byte RetMem, pos+3, 255
next x
next y
endfunction
Anyway, if anyone has some
cool stuff for images, using memblocks, you're free to post it here!
Ofcourse, you're opinion on this is also welcome...
Greets
Sven B
It's the programmer's life:
Have a problem, solve the problem, and have a new problem to solve.
