Tinkering about with Images (and Bitmaps) using Memblocks....

Author

Message

Duffer

21

Years of Service

User Offline

Joined: 9th Feb 2003

Location: chair

Posted: 25th Sep 2006 00:05 Edited at: 25th Sep 2006 00:09

Link

I attach below some (quite a few!) functions for mucking around with images at pixel / alpha level using memblocks...

Rem Project: Experiments with Images & Memblocks
Rem Created: 19/08/2006 22:30:21

Rem ***** Main Source File *****

function GetImgWidth(ImageNumber as integer)
if image exist(ImageNumber) < 1
   exitfunction
endif
if memblock exist(200) > 0
   delete memblock 200
endif
make memblock from image 200,ImageNumber
Width as integer
Width = memblock dword(200,0)
delete memblock 200
endfunction Width

function GetImgHeight(ImageNumber as integer)
if image exist(ImageNumber) < 1
   exitfunction
endif
if memblock exist(200) > 0
   delete memblock 200
endif
make memblock from image 200,ImageNumber
Height as integer
Height = memblock dword(200,4)
delete memblock 200
endfunction Height

function GetImgDepth(ImageNumber as integer)
if image exist(ImageNumber) < 1
   exitfunction
endif
if memblock exist(200) > 0
   delete memblock 200
endif
make memblock from image 200,ImageNumber
Depth as integer
Depth = memblock dword(200,8)
delete memblock 200
endfunction Depth

function GetImgPixels(ImageNumber as integer)
if image exist(ImageNumber) < 1
   exitfunction
endif
hh = GetImgHeight(ImageNumber)
ww = GetImgWidth(ImageNumber)
pixels as integer
pixels = hh * ww
endfunction pixels

function GetImgPixelLoc(ImageNumber as integer,xx as integer,yy as integer)
ww = GetImgWidth(ImageNumber)
hh = GetImgHeight(ImageNumber)
dd = GetImgDepth(ImageNumber)
if xx < 1
   xx = 1
endif
if xx > ww
   xx = ww
endif
if yy < 1
   yy = 1
endif
if yy > hh
   yy = hh
endif
remstart
from byte 12 onwards
remend
if image exist(ImageNumber) < 1
   exitfunction
endif
if memblock exist(300) > 0
   delete memblock 300
endif
make memblock from image 300,ImageNumber
loc as integer
loc = 12 + ((yy * xx) * 4) - 4
delete memblock 300
endfunction loc

function GetImgPixelLocBlue(ImageNumber as integer,xx as integer,yy as integer)
loc as integer
loc = GetImgPixelLoc(ImageNumber,xx,yy)
endfunction loc

function GetImgPixelLocGreen(ImageNumber as integer,xx as integer,yy as integer)
loc as integer
loc = GetImgPixelLoc(ImageNumber,xx,yy)
loc = loc + 1
endfunction loc

function GetImgPixelLocRed(ImageNumber as integer,xx as integer,yy as integer)
loc as integer
loc = GetImgPixelLoc(ImageNumber,xx,yy)
loc = loc + 2
endfunction loc

function GetImgPixelLocAlpha(ImageNumber as integer,xx as integer,yy as integer)
loc as integer
loc = GetImgPixelLoc(ImageNumber,xx,yy)
loc = loc + 3
endfunction loc

function GetImgPixelColour(ImageNumber as integer,xx as integer,yy as integer)
rr as byte
gg as byte
bb as byte
if image exist(ImageNumber) < 1
   exitfunction
endif
if memblock exist(100) > 0
   delete memblock 100
endif
make memblock from image 100,ImageNumber
rr = memblock byte(100,GetImgPixelLocRed(ImageNumber,xx,yy))
gg = memblock byte(100,GetImgPixelLocGreen(ImageNumber,xx,yy))
bb = memblock byte(100,GetImgPixelLocBlue(ImageNumber,xx,yy))
col as integer
col = rgb(rr,gg,bb)
delete memblock 100
endfunction col

function GetImgPixelRed(ImageNumber as integer,xx as integer,yy as integer)
rr as byte
if image exist(ImageNumber) < 1
   exitfunction
endif
if memblock exist(100) > 0
   delete memblock 100
endif
make memblock from image 100,ImageNumber
rr = memblock byte(100,GetImgPixelLocRed(ImageNumber,xx,yy))
delete memblock 100
endfunction rr

function GetImgPixelGreen(ImageNumber as integer,xx as integer,yy as integer)
gg as byte
if image exist(ImageNumber) < 1
   exitfunction
endif
if memblock exist(100) > 0
   delete memblock 100
endif
make memblock from image 100,ImageNumber
gg = memblock byte(100,GetImgPixelLocGreen(ImageNumber,xx,yy))
delete memblock 100
endfunction gg

function GetImgPixelBlue(ImageNumber as integer,xx as integer,yy as integer)
bb as byte
if image exist(ImageNumber) < 1
   exitfunction
endif
if memblock exist(100) > 0
   delete memblock 100
endif
make memblock from image 100,ImageNumber
bb = memblock byte(100,GetImgPixelLocBlue(ImageNumber,xx,yy))
delete memblock 100
endfunction bb

function GetImgPixelAlpha(ImageNumber as integer,xx as integer,yy as integer)
aa as byte
if image exist(ImageNumber) < 1
   exitfunction
endif
if memblock exist(100) > 0
   delete memblock 100
endif
make memblock from image 100,ImageNumber
aa = memblock byte(100,GetImgPixelLocAlpha(ImageNumber,xx,yy))
delete memblock 100
endfunction aa

function GetImgAlpha(ImageNumber)
if image exist(ImageNumber) < 1
   exitfunction
endif
aa as integer
pixels as integer
ww as integer
hh as integer
runningtotal as integer
runningtotal = 0
pixels = GetImgPixels(ImageNumber)
ww = GetImgWidth(ImageNumber)
hh = GetImgHeight(ImageNumber)
for hhh = 1 to hh
for www = 1 to ww
runningtotal = runningtotal + GetImgPixelAlpha(ImageNumber,www,hhh)
next www
next hhh
runningtotal = runningtotal / pixels
aa = runningtotal
endfunction aa

function GetImgRed(ImageNumber)
if image exist(ImageNumber) < 1
   exitfunction
endif
rr as integer
pixels as integer
ww as integer
hh as integer
runningtotal as integer
runningtotal = 0
pixels = GetImgPixels(ImageNumber)
ww = GetImgWidth(ImageNumber)
hh = GetImgHeight(ImageNumber)
for hhh = 1 to hh
for www = 1 to ww
runningtotal = runningtotal + GetImgPixelRed(ImageNumber,www,hhh)
next www
next hhh
runningtotal = runningtotal / pixels
rr = runningtotal
endfunction rr

function GetImgBlue(ImageNumber)
if image exist(ImageNumber) < 1
   exitfunction
endif
bb as integer
pixels as integer
ww as integer
hh as integer
runningtotal as integer
runningtotal = 0
pixels = GetImgPixels(ImageNumber)
ww = GetImgWidth(ImageNumber)
hh = GetImgHeight(ImageNumber)
for hhh = 1 to hh
for www = 1 to ww
runningtotal = runningtotal + GetImgPixelBlue(ImageNumber,www,hhh)
next www
next hhh
runningtotal = runningtotal / pixels
bb = runningtotal
endfunction rr

function GetImgGreen(ImageNumber)
if image exist(ImageNumber) < 1
   exitfunction
endif
gg as integer
pixels as integer
ww as integer
hh as integer
runningtotal as integer
runningtotal = 0
pixels = GetImgPixels(ImageNumber)
ww = GetImgWidth(ImageNumber)
hh = GetImgHeight(ImageNumber)
for hhh = 1 to hh
for www = 1 to ww
runningtotal = runningtotal + GetImgPixelGreen(ImageNumber,www,hhh)
next www
next hhh
runningtotal = runningtotal / pixels
gg = runningtotal
endfunction gg

function GetImgGrey(ImageNumber)
if image exist(ImageNumber) < 1
   exitfunction
endif
grey as integer
rr as integer
gg as integer
bb as integer
pixels as integer
ww as integer
hh as integer
runningtotal as integer
runningtotal = 0
ss as integer
ss = 0
pixels = GetImgPixels(ImageNumber)
ww = GetImgWidth(ImageNumber)
hh = GetImgHeight(ImageNumber)
for hhh = 1 to hh
for www = 1 to ww
ss = 0
ss = ss + GetImgPixelRed(ImageNumber,www,hhh)
ss = ss + GetImgPixelGreen(ImageNumber,www,hhh)
ss = ss + GetImgPixelBlue(ImageNumber,www,hhh)
ss = ss / 3
runningtotal = runningtotal + ss
next www
next hhh
runningtotal = runningtotal / pixels
grey = runningtotal
endfunction grey

function CopyImg(SourceImageNumber as integer,TargetImageNumber as integer)
if image exist(SourceImageNumber) < 1
   exitfunction
endif
if image exist(TargetImageNumber) > 0
   delete image TargetImageNumber
endif
if memblock exist(400) > 0
   delete memblock 400
endif
make memblock from image 400,SourceImageNumber
make image from memblock TargetImageNumber,400
delete memblock 400
endfunction

function SetImgAlpha(ImageNumber as integer, alpha as integer)
if image exist(ImageNumber) < 1
   exitfunction
endif
ww = GetImgWidth(ImageNumber)
hh = GetImgHeight(ImageNumber)
if memblock exist(400) > 0
   delete memblock 400
endif
make memblock from image 400,ImageNumber
if alpha < 0
   alpha = 0
endif
if alpha > 255
   alpha = 255
endif
for xxx = 1 to ww
for yyy = 1 to hh
write memblock byte 400,GetImgPixelLocAlpha(ImageNumber,xxx,yyy),alpha
next yyy
next xxx
delete image ImageNumber
make image from memblock ImageNumber,400
delete memblock 400
endfunction

function SetImgRed(ImageNumber as integer, red as integer)
if image exist(ImageNumber) < 1
   exitfunction
endif
ww = GetImgWidth(ImageNumber)
hh = GetImgHeight(ImageNumber)
if memblock exist(400) > 0
   delete memblock 400
endif
make memblock from image 400,ImageNumber
if red < 0
   red = 0
endif
if red > 255
   red = 255
endif
for xxx = 1 to ww
for yyy = 1 to hh
write memblock byte 400,GetImgPixelLocRed(ImageNumber,xxx,yyy),red
next yyy
next xxx
delete image ImageNumber
make image from memblock ImageNumber,400
delete memblock 400
endfunction

function SetImgGreen(ImageNumber as integer, green as integer)
if image exist(ImageNumber) < 1
   exitfunction
endif
ww = GetImgWidth(ImageNumber)
hh = GetImgHeight(ImageNumber)
if memblock exist(400) > 0
   delete memblock 400
endif
make memblock from image 400,ImageNumber
if green < 0
   green = 0
endif
if green > 255
   green = 255
endif
for xxx = 1 to ww
for yyy = 1 to hh
write memblock byte 400,GetImgPixelLocGreen(ImageNumber,xxx,yyy),green
next yyy
next xxx
delete image ImageNumber
make image from memblock ImageNumber,400
delete memblock 400
endfunction

function SetImgBlue(ImageNumber as integer, blue as integer)
if image exist(ImageNumber) < 1
   exitfunction
endif
ww = GetImgWidth(ImageNumber)
hh = GetImgHeight(ImageNumber)
if memblock exist(400) > 0
   delete memblock 400
endif
make memblock from image 400,ImageNumber
if blue < 0
   blue = 0
endif
if blue > 255
   blue = 255
endif
for xxx = 1 to ww
for yyy = 1 to hh
write memblock byte 400,GetImgPixelLocBlue(ImageNumber,xxx,yyy),blue
next yyy
next xxx
delete image ImageNumber
make image from memblock ImageNumber,400
delete memblock 400
endfunction

function SetImgPixelAlpha(ImageNumber as integer,xx as integer,yy as integer,colbyte as integer)
if image exist(ImageNumber) < 1
   exitfunction
endif
ww = GetImgWidth(ImageNumber)
hh = GetImgHeight(ImageNumber)
if xx > ww
   xx = ww
endif
if xx < 1
   xx = 1
endif
if yy > hh
   yy = hh
endif
if yy < 1
   yy = 1
endif
if colbyte < 0
   colbyte = 0
endif
if colbyte > 255
   colbyte = 255
endif
loc as integer
loc = GetImgPixelLocAlpha(ImageNumber,xx,yy)
if memblock exist(400) > 0
   delete memblock 400
endif
make memblock from image 400,ImageNumber
write memblock byte 400,loc,colbyte
delete image ImageNumber
make image from memblock ImageNumber,400
delete memblock 400
endfunction

function SetImgPixelRed(ImageNumber as integer,xx as integer,yy as integer,colbyte as integer)
if image exist(ImageNumber) < 1
   exitfunction
endif
ww = GetImgWidth(ImageNumber)
hh = GetImgHeight(ImageNumber)
if xx > ww
   xx = ww
endif
if xx < 1
   xx = 1
endif
if yy > hh
   yy = hh
endif
if yy < 1
   yy = 1
endif
if colbyte < 0
   colbyte = 0
endif
if colbyte > 255
   colbyte = 255
endif
loc as integer
loc = GetImgPixelLocRed(ImageNumber,xx,yy)
if memblock exist(400) > 0
   delete memblock 400
endif
make memblock from image 400,ImageNumber
write memblock byte 400,loc,colbyte
delete image ImageNumber
make image from memblock ImageNumber,400
delete memblock 400
endfunction

function SetImgPixelGreen(ImageNumber as integer,xx as integer,yy as integer,colbyte as integer)
if image exist(ImageNumber) < 1
   exitfunction
endif
ww = GetImgWidth(ImageNumber)
hh = GetImgHeight(ImageNumber)
if xx > ww
   xx = ww
endif
if xx < 1
   xx = 1
endif
if yy > hh
   yy = hh
endif
if yy < 1
   yy = 1
endif
if colbyte < 0
   colbyte = 0
endif
if colbyte > 255
   colbyte = 255
endif
loc as integer
loc = GetImgPixelLocRed(ImageNumber,xx,yy)
if memblock exist(400) > 0
   delete memblock 400
endif
make memblock from image 400,ImageNumber
write memblock byte 400,loc,colbyte
delete image ImageNumber
make image from memblock ImageNumber,400
delete memblock 400
endfunction

function SetImgPixelBlue(ImageNumber as integer,xx as integer,yy as integer,colbyte as integer)
if image exist(ImageNumber) < 1
   exitfunction
endif
ww = GetImgWidth(ImageNumber)
hh = GetImgHeight(ImageNumber)
if xx > ww
   xx = ww
endif
if xx < 1
   xx = 1
endif
if yy > hh
   yy = hh
endif
if yy < 1
   yy = 1
endif
if colbyte < 0
   colbyte = 0
endif
if colbyte > 255
   colbyte = 255
endif
loc as integer
loc = GetImgPixelLocRed(ImageNumber,xx,yy)
if memblock exist(400) > 0
   delete memblock 400
endif
make memblock from image 400,ImageNumber
write memblock byte 400,loc,colbyte
delete image ImageNumber
make image from memblock ImageNumber,400
delete memblock 400
endfunction

function SetImgPixelColour(ImageNumber as integer,xx as integer,yy as integer,red as byte,green as byte,blue as byte)
if image exist(ImageNumber) < 1
   exitfunction
endif
ww = GetImgWidth(ImageNumber)
hh = GetImgHeight(ImageNumber)
if xx > ww
   xx = ww
endif
if xx < 1
   xx = 1
endif
if yy > hh
   yy = hh
endif
if yy < 1
   yy = 1
endif
locr as integer
locg as integer
locb as integer
locr = GetImgPixelLocRed(ImageNumber,xx,yy)
locg = GetImgPixelLocRed(ImageNumber,xx,yy)
locb = GetImgPixelLocRed(ImageNumber,xx,yy)
if memblock exist(400) > 0
   delete memblock 400
endif
make memblock from image 400,ImageNumber
write memblock byte 400,locr,red
write memblock byte 400,locg,green
write memblock byte 400,locb,blue
delete image ImageNumber
make image from memblock ImageNumber,400
delete memblock 400
endfunction

function GetBmpWidth(BitmapNumber as integer)
if Bitmap exist(BitmapNumber) < 1
   exitfunction
endif
if memblock exist(200) > 0
   delete memblock 200
endif
make memblock from Bitmap 200,BitmapNumber
Width as integer
Width = memblock dword(200,0)
delete memblock 200
endfunction Width

function GetBmpHeight(BitmapNumber as integer)
if Bitmap exist(BitmapNumber) < 1
   exitfunction
endif
if memblock exist(200) > 0
   delete memblock 200
endif
make memblock from Bitmap 200,BitmapNumber
Height as integer
Height = memblock dword(200,4)
delete memblock 200
endfunction Height

function GetBmpDepth(BitmapNumber as integer)
if Bitmap exist(BitmapNumber) < 1
   exitfunction
endif
if memblock exist(200) > 0
   delete memblock 200
endif
make memblock from Bitmap 200,BitmapNumber
Depth as integer
Depth = memblock dword(200,8)
delete memblock 200
endfunction Depth

function GetBmpPixels(BitmapNumber as integer)
if Bitmap exist(BitmapNumber) < 1
   exitfunction
endif
hh = GetBmpHeight(BitmapNumber)
ww = GetBmpWidth(BitmapNumber)
pixels as integer
pixels = hh * ww
endfunction pixels

function GetBmpPixelLoc(BitmapNumber as integer,xx as integer,yy as integer)
ww = GetBmpWidth(BitmapNumber)
hh = GetBmpHeight(BitmapNumber)
dd = GetBmpDepth(BitmapNumber)
if xx < 1
   xx = 1
endif
if xx > ww
   xx = ww
endif
if yy < 1
   yy = 1
endif
if yy > hh
   yy = hh
endif
remstart
from byte 12 onwards
remend
if Bitmap exist(BitmapNumber) < 1
   exitfunction
endif
if memblock exist(300) > 0
   delete memblock 300
endif
make memblock from Bitmap 300,BitmapNumber
loc as integer
loc = 12 + ((yy * xx) * 4) - 4
delete memblock 300
endfunction loc

function GetBmpPixelLocBlue(BitmapNumber as integer,xx as integer,yy as integer)
loc as integer
loc = GetBmpPixelLoc(BitmapNumber,xx,yy)
endfunction loc

function GetBmpPixelLocGreen(BitmapNumber as integer,xx as integer,yy as integer)
loc as integer
loc = GetBmpPixelLoc(BitmapNumber,xx,yy)
loc = loc + 1
endfunction loc

function GetBmpPixelLocRed(BitmapNumber as integer,xx as integer,yy as integer)
loc as integer
loc = GetBmpPixelLoc(BitmapNumber,xx,yy)
loc = loc + 2
endfunction loc

function GetBmpPixelLocAlpha(BitmapNumber as integer,xx as integer,yy as integer)
loc as integer
loc = GetBmpPixelLoc(BitmapNumber,xx,yy)
loc = loc + 3
endfunction loc

function GetBmpPixelColour(BitmapNumber as integer,xx as integer,yy as integer)
rr as byte
gg as byte
bb as byte
if Bitmap exist(BitmapNumber) < 1
   exitfunction
endif
if memblock exist(100) > 0
   delete memblock 100
endif
make memblock from Bitmap 100,BitmapNumber
rr = memblock byte(100,GetBmpPixelLocRed(BitmapNumber,xx,yy))
gg = memblock byte(100,GetBmpPixelLocGreen(BitmapNumber,xx,yy))
bb = memblock byte(100,GetBmpPixelLocBlue(BitmapNumber,xx,yy))
col as integer
col = rgb(rr,gg,bb)
delete memblock 100
endfunction col

function GetBmpPixelRed(BitmapNumber as integer,xx as integer,yy as integer)
rr as byte
if Bitmap exist(BitmapNumber) < 1
   exitfunction
endif
if memblock exist(100) > 0
   delete memblock 100
endif
make memblock from Bitmap 100,BitmapNumber
rr = memblock byte(100,GetBmpPixelLocRed(BitmapNumber,xx,yy))
delete memblock 100
endfunction rr

function GetBmpPixelGreen(BitmapNumber as integer,xx as integer,yy as integer)
gg as byte
if Bitmap exist(BitmapNumber) < 1
   exitfunction
endif
if memblock exist(100) > 0
   delete memblock 100
endif
make memblock from Bitmap 100,BitmapNumber
gg = memblock byte(100,GetBmpPixelLocGreen(BitmapNumber,xx,yy))
delete memblock 100
endfunction gg

function GetBmpPixelBlue(BitmapNumber as integer,xx as integer,yy as integer)
bb as byte
if Bitmap exist(BitmapNumber) < 1
   exitfunction
endif
if memblock exist(100) > 0
   delete memblock 100
endif
make memblock from Bitmap 100,BitmapNumber
bb = memblock byte(100,GetBmpPixelLocBlue(BitmapNumber,xx,yy))
delete memblock 100
endfunction bb

function GetBmpPixelAlpha(BitmapNumber as integer,xx as integer,yy as integer)
aa as byte
if Bitmap exist(BitmapNumber) < 1
   exitfunction
endif
if memblock exist(100) > 0
   delete memblock 100
endif
make memblock from Bitmap 100,BitmapNumber
aa = memblock byte(100,GetBmpPixelLocAlpha(BitmapNumber,xx,yy))
delete memblock 100
endfunction aa

function GetBmpAlpha(BitmapNumber)
if Bitmap exist(BitmapNumber) < 1
   exitfunction
endif
aa as integer
pixels as integer
ww as integer
hh as integer
runningtotal as integer
runningtotal = 0
pixels = GetBmpPixels(BitmapNumber)
ww = GetBmpWidth(BitmapNumber)
hh = GetBmpHeight(BitmapNumber)
for hhh = 1 to hh
for www = 1 to ww
runningtotal = runningtotal + GetBmpPixelAlpha(BitmapNumber,www,hhh)
next www
next hhh
runningtotal = runningtotal / pixels
aa = runningtotal
endfunction aa

function GetBmpRed(BitmapNumber)
if Bitmap exist(BitmapNumber) < 1
   exitfunction
endif
rr as integer
pixels as integer
ww as integer
hh as integer
runningtotal as integer
runningtotal = 0
pixels = GetBmpPixels(BitmapNumber)
ww = GetBmpWidth(BitmapNumber)
hh = GetBmpHeight(BitmapNumber)
for hhh = 1 to hh
for www = 1 to ww
runningtotal = runningtotal + GetBmpPixelRed(BitmapNumber,www,hhh)
next www
next hhh
runningtotal = runningtotal / pixels
rr = runningtotal
endfunction rr

function GetBmpBlue(BitmapNumber)
if Bitmap exist(BitmapNumber) < 1
   exitfunction
endif
bb as integer
pixels as integer
ww as integer
hh as integer
runningtotal as integer
runningtotal = 0
pixels = GetBmpPixels(BitmapNumber)
ww = GetBmpWidth(BitmapNumber)
hh = GetBmpHeight(BitmapNumber)
for hhh = 1 to hh
for www = 1 to ww
runningtotal = runningtotal + GetBmpPixelBlue(BitmapNumber,www,hhh)
next www
next hhh
runningtotal = runningtotal / pixels
bb = runningtotal
endfunction rr

function GetBmpGreen(BitmapNumber)
if Bitmap exist(BitmapNumber) < 1
   exitfunction
endif
gg as integer
pixels as integer
ww as integer
hh as integer
runningtotal as integer
runningtotal = 0
pixels = GetBmpPixels(BitmapNumber)
ww = GetBmpWidth(BitmapNumber)
hh = GetBmpHeight(BitmapNumber)
for hhh = 1 to hh
for www = 1 to ww
runningtotal = runningtotal + GetBmpPixelGreen(BitmapNumber,www,hhh)
next www
next hhh
runningtotal = runningtotal / pixels
gg = runningtotal
endfunction gg

function GetBmpGrey(BitmapNumber)
if Bitmap exist(BitmapNumber) < 1
   exitfunction
endif
grey as integer
rr as integer
gg as integer
bb as integer
pixels as integer
ww as integer
hh as integer
runningtotal as integer
runningtotal = 0
ss as integer
ss = 0
pixels = GetBmpPixels(BitmapNumber)
ww = GetBmpWidth(BitmapNumber)
hh = GetBmpHeight(BitmapNumber)
for hhh = 1 to hh
for www = 1 to ww
ss = 0
ss = ss + GetBmpPixelRed(BitmapNumber,www,hhh)
ss = ss + GetBmpPixelGreen(BitmapNumber,www,hhh)
ss = ss + GetBmpPixelBlue(BitmapNumber,www,hhh)
ss = ss / 3
runningtotal = runningtotal + ss
next www
next hhh
runningtotal = runningtotal / pixels
grey = runningtotal
endfunction grey

function CopyBmp(SourceBitmapNumber as integer,TargetBitmapNumber as integer)
if Bitmap exist(SourceBitmapNumber) < 1
   exitfunction
endif
if Bitmap exist(TargetBitmapNumber) > 0
   delete Bitmap TargetBitmapNumber
endif
if memblock exist(400) > 0
   delete memblock 400
endif
make memblock from Bitmap 400,SourceBitmapNumber
make Bitmap from memblock TargetBitmapNumber,400
delete memblock 400
endfunction

function SetBmpAlpha(BitmapNumber as integer, alpha as integer)
if Bitmap exist(BitmapNumber) < 1
   exitfunction
endif
ww = GetBmpWidth(BitmapNumber)
hh = GetBmpHeight(BitmapNumber)
if memblock exist(400) > 0
   delete memblock 400
endif
make memblock from Bitmap 400,BitmapNumber
if alpha < 0
   alpha = 0
endif
if alpha > 255
   alpha = 255
endif
for xxx = 1 to ww
for yyy = 1 to hh
write memblock byte 400,GetBmpPixelLocAlpha(BitmapNumber,xxx,yyy),alpha
next yyy
next xxx
delete Bitmap BitmapNumber
make Bitmap from memblock BitmapNumber,400
delete memblock 400
endfunction

function SetBmpRed(BitmapNumber as integer, red as integer)
if Bitmap exist(BitmapNumber) < 1
   exitfunction
endif
ww = GetBmpWidth(BitmapNumber)
hh = GetBmpHeight(BitmapNumber)
if memblock exist(400) > 0
   delete memblock 400
endif
make memblock from Bitmap 400,BitmapNumber
if red < 0
   red = 0
endif
if red > 255
   red = 255
endif
for xxx = 1 to ww
for yyy = 1 to hh
write memblock byte 400,GetBmpPixelLocRed(BitmapNumber,xxx,yyy),red
next yyy
next xxx
delete Bitmap BitmapNumber
make Bitmap from memblock BitmapNumber,400
delete memblock 400
endfunction

function SetBmpGreen(BitmapNumber as integer, green as integer)
if Bitmap exist(BitmapNumber) < 1
   exitfunction
endif
ww = GetBmpWidth(BitmapNumber)
hh = GetBmpHeight(BitmapNumber)
if memblock exist(400) > 0
   delete memblock 400
endif
make memblock from Bitmap 400,BitmapNumber
if green < 0
   green = 0
endif
if green > 255
   green = 255
endif
for xxx = 1 to ww
for yyy = 1 to hh
write memblock byte 400,GetBmpPixelLocGreen(BitmapNumber,xxx,yyy),green
next yyy
next xxx
delete Bitmap BitmapNumber
make Bitmap from memblock BitmapNumber,400
delete memblock 400
endfunction

function SetBmpBlue(BitmapNumber as integer, blue as integer)
if Bitmap exist(BitmapNumber) < 1
   exitfunction
endif
ww = GetBmpWidth(BitmapNumber)
hh = GetBmpHeight(BitmapNumber)
if memblock exist(400) > 0
   delete memblock 400
endif
make memblock from Bitmap 400,BitmapNumber
if blue < 0
   blue = 0
endif
if blue > 255
   blue = 255
endif
for xxx = 1 to ww
for yyy = 1 to hh
write memblock byte 400,GetBmpPixelLocBlue(BitmapNumber,xxx,yyy),blue
next yyy
next xxx
delete Bitmap BitmapNumber
make Bitmap from memblock BitmapNumber,400
delete memblock 400
endfunction

function SetBmpPixelAlpha(BitmapNumber as integer,xx as integer,yy as integer,colbyte as integer)
if Bitmap exist(BitmapNumber) < 1
   exitfunction
endif
ww = GetBmpWidth(BitmapNumber)
hh = GetBmpHeight(BitmapNumber)
if xx > ww
   xx = ww
endif
if xx < 1
   xx = 1
endif
if yy > hh
   yy = hh
endif
if yy < 1
   yy = 1
endif
if colbyte < 0
   colbyte = 0
endif
if colbyte > 255
   colbyte = 255
endif
loc as integer
loc = GetBmpPixelLocAlpha(BitmapNumber,xx,yy)
if memblock exist(400) > 0
   delete memblock 400
endif
make memblock from Bitmap 400,BitmapNumber
write memblock byte 400,loc,colbyte
delete Bitmap BitmapNumber
make Bitmap from memblock BitmapNumber,400
delete memblock 400
endfunction

function SetBmpPixelRed(BitmapNumber as integer,xx as integer,yy as integer,colbyte as integer)
if Bitmap exist(BitmapNumber) < 1
   exitfunction
endif
ww = GetBmpWidth(BitmapNumber)
hh = GetBmpHeight(BitmapNumber)
if xx > ww
   xx = ww
endif
if xx < 1
   xx = 1
endif
if yy > hh
   yy = hh
endif
if yy < 1
   yy = 1
endif
if colbyte < 0
   colbyte = 0
endif
if colbyte > 255
   colbyte = 255
endif
loc as integer
loc = GetBmpPixelLocRed(BitmapNumber,xx,yy)
if memblock exist(400) > 0
   delete memblock 400
endif
make memblock from Bitmap 400,BitmapNumber
write memblock byte 400,loc,colbyte
delete Bitmap BitmapNumber
make Bitmap from memblock BitmapNumber,400
delete memblock 400
endfunction

function SetBmpPixelGreen(BitmapNumber as integer,xx as integer,yy as integer,colbyte as integer)
if Bitmap exist(BitmapNumber) < 1
   exitfunction
endif
ww = GetBmpWidth(BitmapNumber)
hh = GetBmpHeight(BitmapNumber)
if xx > ww
   xx = ww
endif
if xx < 1
   xx = 1
endif
if yy > hh
   yy = hh
endif
if yy < 1
   yy = 1
endif
if colbyte < 0
   colbyte = 0
endif
if colbyte > 255
   colbyte = 255
endif
loc as integer
loc = GetBmpPixelLocRed(BitmapNumber,xx,yy)
if memblock exist(400) > 0
   delete memblock 400
endif
make memblock from Bitmap 400,BitmapNumber
write memblock byte 400,loc,colbyte
delete Bitmap BitmapNumber
make Bitmap from memblock BitmapNumber,400
delete memblock 400
endfunction

function SetBmpPixelBlue(BitmapNumber as integer,xx as integer,yy as integer,colbyte as integer)
if Bitmap exist(BitmapNumber) < 1
   exitfunction
endif
ww = GetBmpWidth(BitmapNumber)
hh = GetBmpHeight(BitmapNumber)
if xx > ww
   xx = ww
endif
if xx < 1
   xx = 1
endif
if yy > hh
   yy = hh
endif
if yy < 1
   yy = 1
endif
if colbyte < 0
   colbyte = 0
endif
if colbyte > 255
   colbyte = 255
endif
loc as integer
loc = GetBmpPixelLocRed(BitmapNumber,xx,yy)
if memblock exist(400) > 0
   delete memblock 400
endif
make memblock from Bitmap 400,BitmapNumber
write memblock byte 400,loc,colbyte
delete Bitmap BitmapNumber
make Bitmap from memblock BitmapNumber,400
delete memblock 400
endfunction

function SetBmpPixelColour(BitmapNumber as integer,xx as integer,yy as integer,red as byte,green as byte,blue as byte)
if Bitmap exist(BitmapNumber) < 1
   exitfunction
endif
ww = GetBmpWidth(BitmapNumber)
hh = GetBmpHeight(BitmapNumber)
if xx > ww
   xx = ww
endif
if xx < 1
   xx = 1
endif
if yy > hh
   yy = hh
endif
if yy < 1
   yy = 1
endif
locr as integer
locg as integer
locb as integer
locr = GetBmpPixelLocRed(BitmapNumber,xx,yy)
locg = GetBmpPixelLocRed(BitmapNumber,xx,yy)
locb = GetBmpPixelLocRed(BitmapNumber,xx,yy)
if memblock exist(400) > 0
   delete memblock 400
endif
make memblock from Bitmap 400,BitmapNumber
write memblock byte 400,locr,red
write memblock byte 400,locg,green
write memblock byte 400,locb,blue
delete Bitmap BitmapNumber
make Bitmap from memblock BitmapNumber,400
delete memblock 400
endfunction

function ResizeImg(ImageNumber as integer,NewX as integer,NewY as integer)
if image exist(ImageNumber) < 1
   exitfunction
endif
if NewX < 1
   NewX = 1
endif
if NewY < 1
   NewY = 1
endif
if bitmap exist(6) > 0
   delete bitmap 6
endif
create bitmap 6,1024,768
set current bitmap 6
if sprite exist(16000) > 0
   delete sprite 16000
endif
sprite 16000,1,1,ImageNumber
hide sprite 16000
size sprite 16000,NewX,NewY
paste sprite 16000,1,1
delete image ImageNumber
get image ImageNumber,1,1,NewX,NewY,1
delete bitmap 6
delete sprite 16000
set current bitmap 0
endfunction

function VerticalFlipImg(ImageNumber)
if image exist(ImageNumber) < 1
   exitfunction
endif
ww = GetImgWidth(ImageNumber)
hh = GetImgHeight(ImageNumber)
if bitmap exist(6) > 0
   delete bitmap 6
endif
create bitmap 6,1024,768
set current bitmap 6
if sprite exist(16000) > 0
   delete sprite 16000
endif
sprite 16000,1,1,ImageNumber
hide sprite 16000
flip sprite 16000
paste sprite 16000,1,1
delete image ImageNumber
get image ImageNumber,1,1,ww,hh,1
delete bitmap 6
delete sprite 16000
set current bitmap 0
endfunction

function HorizontalFlipImg(ImageNumber)
if image exist(ImageNumber) < 1
   exitfunction
endif
ww = GetImgWidth(ImageNumber)
hh = GetImgHeight(ImageNumber)
if bitmap exist(6) > 0
   delete bitmap 6
endif
create bitmap 6,1024,768
set current bitmap 6
if sprite exist(16000) > 0
   delete sprite 16000
endif
sprite 16000,1,1,ImageNumber
hide sprite 16000
mirror sprite 16000
paste sprite 16000,1,1
delete image ImageNumber
get image ImageNumber,1,1,ww,hh,1
delete bitmap 6
delete sprite 16000
set current bitmap 0
endfunction

function RotateImg(ImageNumber as integer,angle as float)
angle1# = wrapvalue(angle)
if image exist(ImageNumber) < 1
   exitfunction
endif
if bitmap exist(6) > 0
   delete bitmap 6
endif
create bitmap 6,1024,768
set current bitmap 6
if sprite exist(16000) > 0
   delete sprite 16000
endif
sprite 16000,1,1,ImageNumber
hide sprite 16000
rotate sprite 16000,angle1#
paste sprite 16000,1,1
xx = sprite width(16000)
yy = sprite height(16000)
delete image ImageNumber
get image ImageNumber,1,1,xx,yy,1
delete bitmap 6
delete sprite 16000
set current bitmap 0
endfunction

function MergeImgAWithImgB(ImageNumberA as integer,ImageNumberB as integer,ResultantImageC as integer)
if image exist(ImageNumberA) < 1
   exitfunction
endif
if image exist(ImageNumberB) < 1
   exitfunction
endif
if image exist(ResultantImageC) > 0
   delete image ResultantImageC
endif
CopyImg(ImageNumberA,15000)
CopyImg(ImageNumberB,15001)
AWidth = GetImgWidth(ImageNumberA)
BWidth = GetImgWidth(ImageNumberB)
AHeight = GetImgHeight(ImageNumberA)
BHeight = GetImgHeight(ImageNumberB)
ASize = AWidth * AHeight
BSize = BWidth * BHeight
if ASize > BSize
   ResizeImg(ImageNumberB,AWidth,AHeight)
   goto jump1
endif
if BSize > ASize
   ResizeImg(ImageNumberA,BWidth,BHeight)
   goto jump1
endif
ResizeImg(ImageNumberB,AWidth,AHeight)
jump1:
if memblock exist(210) > 0
   delete memblock 210
endif
if memblock exist(211) > 0
   delete memblock 211
endif
if memblock exist(212) > 0
   delete memblock 212
endif
make memblock from image 210,ImageNumberA
make memblock from image 211,ImageNumberB
siz = get memblock size(210)
make memblock 212,siz
www = GetImgWidth(ImageNumberA)
hhh = GetImgHeight(ImageNumberA)
ddd = GetImgDepth(ImageNumberA)
write memblock dword 212,0,www
write memblock dword 212,4,hhh
write memblock dword 212,8,ddd
make image from memblock ResultantImageC,212
for xx = 1 to www
for yy = 1 to hhh
ALocR = GetImgPixelLocRed(ImageNumberA,xx,yy)
ALocG = GetImgPixelLocGreen(ImageNumberA,xx,yy)
ALocB = GetImgPixelLocBlue(ImageNumberA,xx,yy)
ALocA = GetImgPixelLocAlpha(ImageNumberA,xx,yy)
BLocR = GetImgPixelLocRed(ImageNumberB,xx,yy)
BLocG = GetImgPixelLocGreen(ImageNumberB,xx,yy)
BLocB = GetImgPixelLocBlue(ImageNumberB,xx,yy)
BLocA = GetImgPixelLocAlpha(ImageNumberB,xx,yy)
CLocR = ALocR + BLocR / 2
CLocG = ALocG + BLocG / 2
CLocB = ALocB + BLocB / 2
CLocA = ALocA + BLocA / 2
SetImgPixelAlpha(ResultantImageC,xx,yy,CLocA)
SetImgPixelRed(ResultantImageC,xx,yy,CLocR)
SetImgPixelGreen(ResultantImageC,xx,yy,CLocG)
SetImgPixelBlue(ResultantImageC,xx,yy,CLocB)
next yy
next xx
CopyImg(15000,ImageNumberA)
CopyImg(15001,ImageNumberB)
delete memblock 210
delete memblock 211
delete memblock 212
delete image 15000
delete image 15001
endfunction

function ProportionalMergeImgAWithImgB(ImageNumberA as integer,ProportionA as integer,ImageNumberB as integer,ProportionB as integer,ResultantImageC as integer)
if image exist(ImageNumberA) < 1
   exitfunction
endif
if image exist(ImageNumberB) < 1
   exitfunction
endif
if image exist(ResultantImageC) > 0
   delete image ResultantImageC
endif
CopyImg(ImageNumberA,15000)
CopyImg(ImageNumberB,15001)
AWidth = GetImgWidth(ImageNumberA)
BWidth = GetImgWidth(ImageNumberB)
AHeight = GetImgHeight(ImageNumberA)
BHeight = GetImgHeight(ImageNumberB)
ASize = AWidth * AHeight
BSize = BWidth * BHeight
if ASize > BSize
   ResizeImg(ImageNumberB,AWidth,AHeight)
   goto jump1
endif
if BSize > ASize
   ResizeImg(ImageNumberA,BWidth,BHeight)
   goto jump1
endif
ResizeImg(ImageNumberB,AWidth,AHeight)
jump1:
if memblock exist(210) > 0
   delete memblock 210
endif
if memblock exist(211) > 0
   delete memblock 211
endif
if memblock exist(212) > 0
   delete memblock 212
endif
make memblock from image 210,ImageNumberA
make memblock from image 211,ImageNumberB
siz = get memblock size(210)
make memblock 212,siz
www = GetImgWidth(ImageNumberA)
hhh = GetImgHeight(ImageNumberA)
ddd = GetImgDepth(ImageNumberA)
write memblock dword 212,0,www
write memblock dword 212,4,hhh
write memblock dword 212,8,ddd
make image from memblock ResultantImageC,212
for xx = 1 to www
for yy = 1 to hhh
ALocR = GetImgPixelLocRed(ImageNumberA,xx,yy)
ALocG = GetImgPixelLocGreen(ImageNumberA,xx,yy)
ALocB = GetImgPixelLocBlue(ImageNumberA,xx,yy)
ALocA = GetImgPixelLocAlpha(ImageNumberA,xx,yy)
BLocR = GetImgPixelLocRed(ImageNumberB,xx,yy)
BLocG = GetImgPixelLocGreen(ImageNumberB,xx,yy)
BLocB = GetImgPixelLocBlue(ImageNumberB,xx,yy)
BLocA = GetImgPixelLocAlpha(ImageNumberB,xx,yy)
TotalP = ProportionA + ProportionB
CLocR = (ALocR * ProportionA) + (BLocR * ProportionB) / TotalP / 2
CLocG = (ALocG * ProportionA) + (BLocG * ProportionB) / TotalP / 2
CLocB = (ALocB * ProportionA) + (BLocB * ProportionB) / TotalP / 2
CLocA = (ALocA * ProportionA) + (BLocA * ProportionB) / TotalP / 2
SetImgPixelAlpha(ResultantImageC,xx,yy,CLocA)
SetImgPixelRed(ResultantImageC,xx,yy,CLocR)
SetImgPixelGreen(ResultantImageC,xx,yy,CLocG)
SetImgPixelBlue(ResultantImageC,xx,yy,CLocB)
next yy
next xx
CopyImg(15000,ImageNumberA)
CopyImg(15001,ImageNumberB)
delete memblock 210
delete memblock 211
delete memblock 212
delete image 15000
delete image 15001
endfunction

function MakeImgGreyscale(ImageNumber as integer)
if image exist(ImageNumber) < 1
   exitfunction
endif
ww = GetImgWidth(ImageNumber)
hh = GetImgHeight(ImageNumber)
for x = 1 to ww
for y = 1 to hh
rr = GetImgPixelRed(ImageNumber,x,y)
gg = GetImgPixelGreen(ImageNumber,x,y)
bb = GetImgPixelBlue(ImageNumber,x,y)
tt = rr + gg + bb / 3
SetImgPixelColour(ImageNumber,x,y,tt,tt,tt)
next y
next x
endfunction

function MakeImgRedscale(ImageNumber as integer)
if image exist(ImageNumber) < 1
   exitfunction
endif
ww = GetImgWidth(ImageNumber)
hh = GetImgHeight(ImageNumber)
for x = 1 to ww
for y = 1 to hh
rr = GetImgPixelRed(ImageNumber,x,y)
gg = GetImgPixelGreen(ImageNumber,x,y)
bb = GetImgPixelBlue(ImageNumber,x,y)
tt = rr + gg + bb / 3
SetImgPixelColour(ImageNumber,x,y,tt,0,0)
next y
next x
endfunction

function MakeImgGreenscale(ImageNumber as integer)
if image exist(ImageNumber) < 1
   exitfunction
endif
ww = GetImgWidth(ImageNumber)
hh = GetImgHeight(ImageNumber)
for x = 1 to ww
for y = 1 to hh
rr = GetImgPixelRed(ImageNumber,x,y)
gg = GetImgPixelGreen(ImageNumber,x,y)
bb = GetImgPixelBlue(ImageNumber,x,y)
tt = rr + gg + bb / 3
SetImgPixelColour(ImageNumber,x,y,0,tt,0)
next y
next x
endfunction

function MakeImgBluescale(ImageNumber as integer)
if image exist(ImageNumber) < 1
   exitfunction
endif
ww = GetImgWidth(ImageNumber)
hh = GetImgHeight(ImageNumber)
for x = 1 to ww
for y = 1 to hh
aa = GetImgPixelAlpha(ImageNumber,x,y)
rr = GetImgPixelRed(ImageNumber,x,y)
gg = GetImgPixelGreen(ImageNumber,x,y)
bb = GetImgPixelBlue(ImageNumber,x,y)
tt = rr + gg + bb / 3
SetImgPixelColour(ImageNumber,x,y,0,0,tt)
next y
next x
endfunction

function IncreaseImgAlpha(ImageNumber as integer,Percentage as integer)
if image exist(ImageNumber) < 1
   exitfunction
endif
ww = GetImgWidth(ImageNumber)
hh = GetImgHeight(ImageNumber)
for x = 1 to ww
for y = 1 to hh
aa = GetImgPixelAlpha(ImageNumber,x,y)
aaa = 255 - aa
aaaa# = aaa / 100
aaaaa# = aaaa# * Percentage
aa1 = int(aaaaa#)
SetImgPixelAlpha(ImageNumber,x,y,aa1)
next y
next x
endfunction

function DecreaseImgAlpha(ImageNumber as integer,Percentage as integer)
if image exist(ImageNumber) < 1
   exitfunction
endif
ww = GetImgWidth(ImageNumber)
hh = GetImgHeight(ImageNumber)
for x = 1 to ww
for y = 1 to hh
aa = GetImgPixelAlpha(ImageNumber,x,y)
aaa = aa
aaaa# = aaa / 100
aaaaa# = aaaa# * Percentage
aa1 = aaa - int(aaaaa#)
SetImgPixelAlpha(ImageNumber,x,y,aa1)
next y
next x
endfunction

function IncreaseImgRed(ImageNumber as integer,Percentage as integer)
if image exist(ImageNumber) < 1
   exitfunction
endif
ww = GetImgWidth(ImageNumber)
hh = GetImgHeight(ImageNumber)
for x = 1 to ww
for y = 1 to hh
aa = GetImgPixelRed(ImageNumber,x,y)
aaa = 255 - aa
aaaa# = aaa / 100
aaaaa# = aaaa# * Percentage
aa1 = int(aaaaa#)
SetImgPixelRed(ImageNumber,x,y,aa1)
next y
next x
endfunction

function DecreaseImgRed(ImageNumber as integer,Percentage as integer)
if image exist(ImageNumber) < 1
   exitfunction
endif
ww = GetImgWidth(ImageNumber)
hh = GetImgHeight(ImageNumber)
for x = 1 to ww
for y = 1 to hh
aa = GetImgPixelRed(ImageNumber,x,y)
aaa = aa
aaaa# = aaa / 100
aaaaa# = aaaa# * Percentage
aa1 = aaa - int(aaaaa#)
SetImgPixelRed(ImageNumber,x,y,aa1)
next y
next x
endfunction

function IncreaseImgGreen(ImageNumber as integer,Percentage as integer)
if image exist(ImageNumber) < 1
   exitfunction
endif
ww = GetImgWidth(ImageNumber)
hh = GetImgHeight(ImageNumber)
for x = 1 to ww
for y = 1 to hh
aa = GetImgPixelGreen(ImageNumber,x,y)
aaa = 255 - aa
aaaa# = aaa / 100
aaaaa# = aaaa# * Percentage
aa1 = int(aaaaa#)
SetImgPixelGreen(ImageNumber,x,y,aa1)
next y
next x
endfunction

function DecreaseImgGreen(ImageNumber as integer,Percentage as integer)
if image exist(ImageNumber) < 1
   exitfunction
endif
ww = GetImgWidth(ImageNumber)
hh = GetImgHeight(ImageNumber)
for x = 1 to ww
for y = 1 to hh
aa = GetImgPixelGreen(ImageNumber,x,y)
aaa = aa
aaaa# = aaa / 100
aaaaa# = aaaa# * Percentage
aa1 = aaa - int(aaaaa#)
SetImgPixelGreen(ImageNumber,x,y,aa1)
next y
next x
endfunction

function IncreaseImgBlue(ImageNumber as integer,Percentage as integer)
if image exist(ImageNumber) < 1
   exitfunction
endif
ww = GetImgWidth(ImageNumber)
hh = GetImgHeight(ImageNumber)
for x = 1 to ww
for y = 1 to hh
aa = GetImgPixelBlue(ImageNumber,x,y)
aaa = 255 - aa
aaaa# = aaa / 100
aaaaa# = aaaa# * Percentage
aa1 = int(aaaaa#)
SetImgPixelBlue(ImageNumber,x,y,aa1)
next y
next x
endfunction

function DecreaseImgBlue(ImageNumber as integer,Percentage as integer)
if image exist(ImageNumber) < 1
   exitfunction
endif
ww = GetImgWidth(ImageNumber)
hh = GetImgHeight(ImageNumber)
for x = 1 to ww
for y = 1 to hh
aa = GetImgPixelBlue(ImageNumber,x,y)
aaa = aa
aaaa# = aaa / 100
aaaaa# = aaaa# * Percentage
aa1 = aaa - int(aaaaa#)
SetImgPixelBlue(ImageNumber,x,y,aa1)
next y
next x
endfunction

+ Code Snippet

Rem Project: Experiments with Images & Memblocks
Rem Created: 19/08/2006 22:30:21

Rem ***** Main Source File *****

function GetImgWidth(ImageNumber as integer)
if image exist(ImageNumber) < 1
   exitfunction
endif
if memblock exist(200) > 0
   delete memblock 200
endif
make memblock from image 200,ImageNumber
Width as integer
Width = memblock dword(200,0)
delete memblock 200
endfunction Width

function GetImgHeight(ImageNumber as integer)
if image exist(ImageNumber) < 1
   exitfunction
endif
if memblock exist(200) > 0
   delete memblock 200
endif
make memblock from image 200,ImageNumber
Height as integer
Height = memblock dword(200,4)
delete memblock 200
endfunction Height

function GetImgDepth(ImageNumber as integer)
if image exist(ImageNumber) < 1
   exitfunction
endif
if memblock exist(200) > 0
   delete memblock 200
endif
make memblock from image 200,ImageNumber
Depth as integer
Depth = memblock dword(200,8)
delete memblock 200
endfunction Depth

function GetImgPixels(ImageNumber as integer)
if image exist(ImageNumber) < 1
   exitfunction
endif
hh = GetImgHeight(ImageNumber)
ww = GetImgWidth(ImageNumber)
pixels as integer
pixels = hh * ww
endfunction pixels

function GetImgPixelLoc(ImageNumber as integer,xx as integer,yy as integer)
ww = GetImgWidth(ImageNumber)
hh = GetImgHeight(ImageNumber)
dd = GetImgDepth(ImageNumber)
if xx < 1
   xx = 1
endif
if xx > ww
   xx = ww
endif
if yy < 1
   yy = 1
endif
if yy > hh
   yy = hh
endif
remstart
from byte 12 onwards
remend
if image exist(ImageNumber) < 1
   exitfunction
endif
if memblock exist(300) > 0
   delete memblock 300
endif
make memblock from image 300,ImageNumber
loc as integer
loc = 12 + ((yy * xx) * 4) - 4
delete memblock 300
endfunction loc

function GetImgPixelLocBlue(ImageNumber as integer,xx as integer,yy as integer)
loc as integer
loc = GetImgPixelLoc(ImageNumber,xx,yy)
endfunction loc

function GetImgPixelLocGreen(ImageNumber as integer,xx as integer,yy as integer)
loc as integer
loc = GetImgPixelLoc(ImageNumber,xx,yy)
loc = loc + 1
endfunction loc

function GetImgPixelLocRed(ImageNumber as integer,xx as integer,yy as integer)
loc as integer
loc = GetImgPixelLoc(ImageNumber,xx,yy)
loc = loc + 2
endfunction loc

function GetImgPixelLocAlpha(ImageNumber as integer,xx as integer,yy as integer)
loc as integer
loc = GetImgPixelLoc(ImageNumber,xx,yy)
loc = loc + 3
endfunction loc

function GetImgPixelColour(ImageNumber as integer,xx as integer,yy as integer)
rr as byte
gg as byte
bb as byte
if image exist(ImageNumber) < 1
   exitfunction
endif
if memblock exist(100) > 0
   delete memblock 100
endif
make memblock from image 100,ImageNumber
rr = memblock byte(100,GetImgPixelLocRed(ImageNumber,xx,yy))
gg = memblock byte(100,GetImgPixelLocGreen(ImageNumber,xx,yy))
bb = memblock byte(100,GetImgPixelLocBlue(ImageNumber,xx,yy))
col as integer
col = rgb(rr,gg,bb)
delete memblock 100
endfunction col

function GetImgPixelRed(ImageNumber as integer,xx as integer,yy as integer)
rr as byte
if image exist(ImageNumber) < 1
   exitfunction
endif
if memblock exist(100) > 0
   delete memblock 100
endif
make memblock from image 100,ImageNumber
rr = memblock byte(100,GetImgPixelLocRed(ImageNumber,xx,yy))
delete memblock 100
endfunction rr

function GetImgPixelGreen(ImageNumber as integer,xx as integer,yy as integer)
gg as byte
if image exist(ImageNumber) < 1
   exitfunction
endif
if memblock exist(100) > 0
   delete memblock 100
endif
make memblock from image 100,ImageNumber
gg = memblock byte(100,GetImgPixelLocGreen(ImageNumber,xx,yy))
delete memblock 100
endfunction gg

function GetImgPixelBlue(ImageNumber as integer,xx as integer,yy as integer)
bb as byte
if image exist(ImageNumber) < 1
   exitfunction
endif
if memblock exist(100) > 0
   delete memblock 100
endif
make memblock from image 100,ImageNumber
bb = memblock byte(100,GetImgPixelLocBlue(ImageNumber,xx,yy))
delete memblock 100
endfunction bb

function GetImgPixelAlpha(ImageNumber as integer,xx as integer,yy as integer)
aa as byte
if image exist(ImageNumber) < 1
   exitfunction
endif
if memblock exist(100) > 0
   delete memblock 100
endif
make memblock from image 100,ImageNumber
aa = memblock byte(100,GetImgPixelLocAlpha(ImageNumber,xx,yy))
delete memblock 100
endfunction aa

function GetImgAlpha(ImageNumber)
if image exist(ImageNumber) < 1
   exitfunction
endif
aa as integer
pixels as integer
ww as integer
hh as integer
runningtotal as integer
runningtotal = 0
pixels = GetImgPixels(ImageNumber)
ww = GetImgWidth(ImageNumber)
hh = GetImgHeight(ImageNumber)
for hhh = 1 to hh
for www = 1 to ww
runningtotal = runningtotal + GetImgPixelAlpha(ImageNumber,www,hhh)
next www
next hhh
runningtotal = runningtotal / pixels
aa = runningtotal
endfunction aa

function GetImgRed(ImageNumber)
if image exist(ImageNumber) < 1
   exitfunction
endif
rr as integer
pixels as integer
ww as integer
hh as integer
runningtotal as integer
runningtotal = 0
pixels = GetImgPixels(ImageNumber)
ww = GetImgWidth(ImageNumber)
hh = GetImgHeight(ImageNumber)
for hhh = 1 to hh
for www = 1 to ww
runningtotal = runningtotal + GetImgPixelRed(ImageNumber,www,hhh)
next www
next hhh
runningtotal = runningtotal / pixels
rr = runningtotal
endfunction rr

function GetImgBlue(ImageNumber)
if image exist(ImageNumber) < 1
   exitfunction
endif
bb as integer
pixels as integer
ww as integer
hh as integer
runningtotal as integer
runningtotal = 0
pixels = GetImgPixels(ImageNumber)
ww = GetImgWidth(ImageNumber)
hh = GetImgHeight(ImageNumber)
for hhh = 1 to hh
for www = 1 to ww
runningtotal = runningtotal + GetImgPixelBlue(ImageNumber,www,hhh)
next www
next hhh
runningtotal = runningtotal / pixels
bb = runningtotal
endfunction rr

function GetImgGreen(ImageNumber)
if image exist(ImageNumber) < 1
   exitfunction
endif
gg as integer
pixels as integer
ww as integer
hh as integer
runningtotal as integer
runningtotal = 0
pixels = GetImgPixels(ImageNumber)
ww = GetImgWidth(ImageNumber)
hh = GetImgHeight(ImageNumber)
for hhh = 1 to hh
for www = 1 to ww
runningtotal = runningtotal + GetImgPixelGreen(ImageNumber,www,hhh)
next www
next hhh
runningtotal = runningtotal / pixels
gg = runningtotal
endfunction gg

function GetImgGrey(ImageNumber)
if image exist(ImageNumber) < 1
   exitfunction
endif
grey as integer
rr as integer
gg as integer
bb as integer
pixels as integer
ww as integer
hh as integer
runningtotal as integer
runningtotal = 0
ss as integer
ss = 0
pixels = GetImgPixels(ImageNumber)
ww = GetImgWidth(ImageNumber)
hh = GetImgHeight(ImageNumber)
for hhh = 1 to hh
for www = 1 to ww
ss = 0
ss = ss + GetImgPixelRed(ImageNumber,www,hhh)
ss = ss + GetImgPixelGreen(ImageNumber,www,hhh)
ss = ss + GetImgPixelBlue(ImageNumber,www,hhh)
ss = ss / 3
runningtotal = runningtotal + ss
next www
next hhh
runningtotal = runningtotal / pixels
grey = runningtotal
endfunction grey

function CopyImg(SourceImageNumber as integer,TargetImageNumber as integer)
if image exist(SourceImageNumber) < 1
   exitfunction
endif
if image exist(TargetImageNumber) > 0
   delete image TargetImageNumber
endif
if memblock exist(400) > 0
   delete memblock 400
endif
make memblock from image 400,SourceImageNumber
make image from memblock TargetImageNumber,400
delete memblock 400
endfunction

function SetImgAlpha(ImageNumber as integer, alpha as integer)
if image exist(ImageNumber) < 1
   exitfunction
endif
ww = GetImgWidth(ImageNumber)
hh = GetImgHeight(ImageNumber)
if memblock exist(400) > 0
   delete memblock 400
endif
make memblock from image 400,ImageNumber
if alpha < 0
   alpha = 0
endif
if alpha > 255
   alpha = 255
endif
for xxx = 1 to ww
for yyy = 1 to hh
write memblock byte 400,GetImgPixelLocAlpha(ImageNumber,xxx,yyy),alpha
next yyy
next xxx
delete image ImageNumber
make image from memblock ImageNumber,400
delete memblock 400
endfunction

function SetImgRed(ImageNumber as integer, red as integer)
if image exist(ImageNumber) < 1
   exitfunction
endif
ww = GetImgWidth(ImageNumber)
hh = GetImgHeight(ImageNumber)
if memblock exist(400) > 0
   delete memblock 400
endif
make memblock from image 400,ImageNumber
if red < 0
   red = 0
endif
if red > 255
   red = 255
endif
for xxx = 1 to ww
for yyy = 1 to hh
write memblock byte 400,GetImgPixelLocRed(ImageNumber,xxx,yyy),red
next yyy
next xxx
delete image ImageNumber
make image from memblock ImageNumber,400
delete memblock 400
endfunction

function SetImgGreen(ImageNumber as integer, green as integer)
if image exist(ImageNumber) < 1
   exitfunction
endif
ww = GetImgWidth(ImageNumber)
hh = GetImgHeight(ImageNumber)
if memblock exist(400) > 0
   delete memblock 400
endif
make memblock from image 400,ImageNumber
if green < 0
   green = 0
endif
if green > 255
   green = 255
endif
for xxx = 1 to ww
for yyy = 1 to hh
write memblock byte 400,GetImgPixelLocGreen(ImageNumber,xxx,yyy),green
next yyy
next xxx
delete image ImageNumber
make image from memblock ImageNumber,400
delete memblock 400
endfunction

function SetImgBlue(ImageNumber as integer, blue as integer)
if image exist(ImageNumber) < 1
   exitfunction
endif
ww = GetImgWidth(ImageNumber)
hh = GetImgHeight(ImageNumber)
if memblock exist(400) > 0
   delete memblock 400
endif
make memblock from image 400,ImageNumber
if blue < 0
   blue = 0
endif
if blue > 255
   blue = 255
endif
for xxx = 1 to ww
for yyy = 1 to hh
write memblock byte 400,GetImgPixelLocBlue(ImageNumber,xxx,yyy),blue
next yyy
next xxx
delete image ImageNumber
make image from memblock ImageNumber,400
delete memblock 400
endfunction

function SetImgPixelAlpha(ImageNumber as integer,xx as integer,yy as integer,colbyte as integer)
if image exist(ImageNumber) < 1
   exitfunction
endif
ww = GetImgWidth(ImageNumber)
hh = GetImgHeight(ImageNumber)
if xx > ww
   xx = ww
endif
if xx < 1
   xx = 1
endif
if yy > hh
   yy = hh
endif
if yy < 1
   yy = 1
endif
if colbyte < 0
   colbyte = 0
endif
if colbyte > 255
   colbyte = 255
endif
loc as integer
loc = GetImgPixelLocAlpha(ImageNumber,xx,yy)
if memblock exist(400) > 0
   delete memblock 400
endif
make memblock from image 400,ImageNumber
write memblock byte 400,loc,colbyte
delete image ImageNumber
make image from memblock ImageNumber,400
delete memblock 400
endfunction

function SetImgPixelRed(ImageNumber as integer,xx as integer,yy as integer,colbyte as integer)
if image exist(ImageNumber) < 1
   exitfunction
endif
ww = GetImgWidth(ImageNumber)
hh = GetImgHeight(ImageNumber)
if xx > ww
   xx = ww
endif
if xx < 1
   xx = 1
endif
if yy > hh
   yy = hh
endif
if yy < 1
   yy = 1
endif
if colbyte < 0
   colbyte = 0
endif
if colbyte > 255
   colbyte = 255
endif
loc as integer
loc = GetImgPixelLocRed(ImageNumber,xx,yy)
if memblock exist(400) > 0
   delete memblock 400
endif
make memblock from image 400,ImageNumber
write memblock byte 400,loc,colbyte
delete image ImageNumber
make image from memblock ImageNumber,400
delete memblock 400
endfunction

function SetImgPixelGreen(ImageNumber as integer,xx as integer,yy as integer,colbyte as integer)
if image exist(ImageNumber) < 1
   exitfunction
endif
ww = GetImgWidth(ImageNumber)
hh = GetImgHeight(ImageNumber)
if xx > ww
   xx = ww
endif
if xx < 1
   xx = 1
endif
if yy > hh
   yy = hh
endif
if yy < 1
   yy = 1
endif
if colbyte < 0
   colbyte = 0
endif
if colbyte > 255
   colbyte = 255
endif
loc as integer
loc = GetImgPixelLocRed(ImageNumber,xx,yy)
if memblock exist(400) > 0
   delete memblock 400
endif
make memblock from image 400,ImageNumber
write memblock byte 400,loc,colbyte
delete image ImageNumber
make image from memblock ImageNumber,400
delete memblock 400
endfunction

function SetImgPixelBlue(ImageNumber as integer,xx as integer,yy as integer,colbyte as integer)
if image exist(ImageNumber) < 1
   exitfunction
endif
ww = GetImgWidth(ImageNumber)
hh = GetImgHeight(ImageNumber)
if xx > ww
   xx = ww
endif
if xx < 1
   xx = 1
endif
if yy > hh
   yy = hh
endif
if yy < 1
   yy = 1
endif
if colbyte < 0
   colbyte = 0
endif
if colbyte > 255
   colbyte = 255
endif
loc as integer
loc = GetImgPixelLocRed(ImageNumber,xx,yy)
if memblock exist(400) > 0
   delete memblock 400
endif
make memblock from image 400,ImageNumber
write memblock byte 400,loc,colbyte
delete image ImageNumber
make image from memblock ImageNumber,400
delete memblock 400
endfunction

function SetImgPixelColour(ImageNumber as integer,xx as integer,yy as integer,red as byte,green as byte,blue as byte)
if image exist(ImageNumber) < 1
   exitfunction
endif
ww = GetImgWidth(ImageNumber)
hh = GetImgHeight(ImageNumber)
if xx > ww
   xx = ww
endif
if xx < 1
   xx = 1
endif
if yy > hh
   yy = hh
endif
if yy < 1
   yy = 1
endif
locr as integer
locg as integer
locb as integer
locr = GetImgPixelLocRed(ImageNumber,xx,yy)
locg = GetImgPixelLocRed(ImageNumber,xx,yy)
locb = GetImgPixelLocRed(ImageNumber,xx,yy)
if memblock exist(400) > 0
   delete memblock 400
endif
make memblock from image 400,ImageNumber
write memblock byte 400,locr,red
write memblock byte 400,locg,green
write memblock byte 400,locb,blue
delete image ImageNumber
make image from memblock ImageNumber,400
delete memblock 400
endfunction

function GetBmpWidth(BitmapNumber as integer)
if Bitmap exist(BitmapNumber) < 1
   exitfunction
endif
if memblock exist(200) > 0
   delete memblock 200
endif
make memblock from Bitmap 200,BitmapNumber
Width as integer
Width = memblock dword(200,0)
delete memblock 200
endfunction Width

function GetBmpHeight(BitmapNumber as integer)
if Bitmap exist(BitmapNumber) < 1
   exitfunction
endif
if memblock exist(200) > 0
   delete memblock 200
endif
make memblock from Bitmap 200,BitmapNumber
Height as integer
Height = memblock dword(200,4)
delete memblock 200
endfunction Height

function GetBmpDepth(BitmapNumber as integer)
if Bitmap exist(BitmapNumber) < 1
   exitfunction
endif
if memblock exist(200) > 0
   delete memblock 200
endif
make memblock from Bitmap 200,BitmapNumber
Depth as integer
Depth = memblock dword(200,8)
delete memblock 200
endfunction Depth

function GetBmpPixels(BitmapNumber as integer)
if Bitmap exist(BitmapNumber) < 1
   exitfunction
endif
hh = GetBmpHeight(BitmapNumber)
ww = GetBmpWidth(BitmapNumber)
pixels as integer
pixels = hh * ww
endfunction pixels

function GetBmpPixelLoc(BitmapNumber as integer,xx as integer,yy as integer)
ww = GetBmpWidth(BitmapNumber)
hh = GetBmpHeight(BitmapNumber)
dd = GetBmpDepth(BitmapNumber)
if xx < 1
   xx = 1
endif
if xx > ww
   xx = ww
endif
if yy < 1
   yy = 1
endif
if yy > hh
   yy = hh
endif
remstart
from byte 12 onwards
remend
if Bitmap exist(BitmapNumber) < 1
   exitfunction
endif
if memblock exist(300) > 0
   delete memblock 300
endif
make memblock from Bitmap 300,BitmapNumber
loc as integer
loc = 12 + ((yy * xx) * 4) - 4
delete memblock 300
endfunction loc

function GetBmpPixelLocBlue(BitmapNumber as integer,xx as integer,yy as integer)
loc as integer
loc = GetBmpPixelLoc(BitmapNumber,xx,yy)
endfunction loc

function GetBmpPixelLocGreen(BitmapNumber as integer,xx as integer,yy as integer)
loc as integer
loc = GetBmpPixelLoc(BitmapNumber,xx,yy)
loc = loc + 1
endfunction loc

function GetBmpPixelLocRed(BitmapNumber as integer,xx as integer,yy as integer)
loc as integer
loc = GetBmpPixelLoc(BitmapNumber,xx,yy)
loc = loc + 2
endfunction loc

function GetBmpPixelLocAlpha(BitmapNumber as integer,xx as integer,yy as integer)
loc as integer
loc = GetBmpPixelLoc(BitmapNumber,xx,yy)
loc = loc + 3
endfunction loc

function GetBmpPixelColour(BitmapNumber as integer,xx as integer,yy as integer)
rr as byte
gg as byte
bb as byte
if Bitmap exist(BitmapNumber) < 1
   exitfunction
endif
if memblock exist(100) > 0
   delete memblock 100
endif
make memblock from Bitmap 100,BitmapNumber
rr = memblock byte(100,GetBmpPixelLocRed(BitmapNumber,xx,yy))
gg = memblock byte(100,GetBmpPixelLocGreen(BitmapNumber,xx,yy))
bb = memblock byte(100,GetBmpPixelLocBlue(BitmapNumber,xx,yy))
col as integer
col = rgb(rr,gg,bb)
delete memblock 100
endfunction col

function GetBmpPixelRed(BitmapNumber as integer,xx as integer,yy as integer)
rr as byte
if Bitmap exist(BitmapNumber) < 1
   exitfunction
endif
if memblock exist(100) > 0
   delete memblock 100
endif
make memblock from Bitmap 100,BitmapNumber
rr = memblock byte(100,GetBmpPixelLocRed(BitmapNumber,xx,yy))
delete memblock 100
endfunction rr

function GetBmpPixelGreen(BitmapNumber as integer,xx as integer,yy as integer)
gg as byte
if Bitmap exist(BitmapNumber) < 1
   exitfunction
endif
if memblock exist(100) > 0
   delete memblock 100
endif
make memblock from Bitmap 100,BitmapNumber
gg = memblock byte(100,GetBmpPixelLocGreen(BitmapNumber,xx,yy))
delete memblock 100
endfunction gg

function GetBmpPixelBlue(BitmapNumber as integer,xx as integer,yy as integer)
bb as byte
if Bitmap exist(BitmapNumber) < 1
   exitfunction
endif
if memblock exist(100) > 0
   delete memblock 100
endif
make memblock from Bitmap 100,BitmapNumber
bb = memblock byte(100,GetBmpPixelLocBlue(BitmapNumber,xx,yy))
delete memblock 100
endfunction bb

function GetBmpPixelAlpha(BitmapNumber as integer,xx as integer,yy as integer)
aa as byte
if Bitmap exist(BitmapNumber) < 1
   exitfunction
endif
if memblock exist(100) > 0
   delete memblock 100
endif
make memblock from Bitmap 100,BitmapNumber
aa = memblock byte(100,GetBmpPixelLocAlpha(BitmapNumber,xx,yy))
delete memblock 100
endfunction aa

function GetBmpAlpha(BitmapNumber)
if Bitmap exist(BitmapNumber) < 1
   exitfunction
endif
aa as integer
pixels as integer
ww as integer
hh as integer
runningtotal as integer
runningtotal = 0
pixels = GetBmpPixels(BitmapNumber)
ww = GetBmpWidth(BitmapNumber)
hh = GetBmpHeight(BitmapNumber)
for hhh = 1 to hh
for www = 1 to ww
runningtotal = runningtotal + GetBmpPixelAlpha(BitmapNumber,www,hhh)
next www
next hhh
runningtotal = runningtotal / pixels
aa = runningtotal
endfunction aa

function GetBmpRed(BitmapNumber)
if Bitmap exist(BitmapNumber) < 1
   exitfunction
endif
rr as integer
pixels as integer
ww as integer
hh as integer
runningtotal as integer
runningtotal = 0
pixels = GetBmpPixels(BitmapNumber)
ww = GetBmpWidth(BitmapNumber)
hh = GetBmpHeight(BitmapNumber)
for hhh = 1 to hh
for www = 1 to ww
runningtotal = runningtotal + GetBmpPixelRed(BitmapNumber,www,hhh)
next www
next hhh
runningtotal = runningtotal / pixels
rr = runningtotal
endfunction rr

function GetBmpBlue(BitmapNumber)
if Bitmap exist(BitmapNumber) < 1
   exitfunction
endif
bb as integer
pixels as integer
ww as integer
hh as integer
runningtotal as integer
runningtotal = 0
pixels = GetBmpPixels(BitmapNumber)
ww = GetBmpWidth(BitmapNumber)
hh = GetBmpHeight(BitmapNumber)
for hhh = 1 to hh
for www = 1 to ww
runningtotal = runningtotal + GetBmpPixelBlue(BitmapNumber,www,hhh)
next www
next hhh
runningtotal = runningtotal / pixels
bb = runningtotal
endfunction rr

function GetBmpGreen(BitmapNumber)
if Bitmap exist(BitmapNumber) < 1
   exitfunction
endif
gg as integer
pixels as integer
ww as integer
hh as integer
runningtotal as integer
runningtotal = 0
pixels = GetBmpPixels(BitmapNumber)
ww = GetBmpWidth(BitmapNumber)
hh = GetBmpHeight(BitmapNumber)
for hhh = 1 to hh
for www = 1 to ww
runningtotal = runningtotal + GetBmpPixelGreen(BitmapNumber,www,hhh)
next www
next hhh
runningtotal = runningtotal / pixels
gg = runningtotal
endfunction gg

function GetBmpGrey(BitmapNumber)
if Bitmap exist(BitmapNumber) < 1
   exitfunction
endif
grey as integer
rr as integer
gg as integer
bb as integer
pixels as integer
ww as integer
hh as integer
runningtotal as integer
runningtotal = 0
ss as integer
ss = 0
pixels = GetBmpPixels(BitmapNumber)
ww = GetBmpWidth(BitmapNumber)
hh = GetBmpHeight(BitmapNumber)
for hhh = 1 to hh
for www = 1 to ww
ss = 0
ss = ss + GetBmpPixelRed(BitmapNumber,www,hhh)
ss = ss + GetBmpPixelGreen(BitmapNumber,www,hhh)
ss = ss + GetBmpPixelBlue(BitmapNumber,www,hhh)
ss = ss / 3
runningtotal = runningtotal + ss
next www
next hhh
runningtotal = runningtotal / pixels
grey = runningtotal
endfunction grey

function CopyBmp(SourceBitmapNumber as integer,TargetBitmapNumber as integer)
if Bitmap exist(SourceBitmapNumber) < 1
   exitfunction
endif
if Bitmap exist(TargetBitmapNumber) > 0
   delete Bitmap TargetBitmapNumber
endif
if memblock exist(400) > 0
   delete memblock 400
endif
make memblock from Bitmap 400,SourceBitmapNumber
make Bitmap from memblock TargetBitmapNumber,400
delete memblock 400
endfunction

function SetBmpAlpha(BitmapNumber as integer, alpha as integer)
if Bitmap exist(BitmapNumber) < 1
   exitfunction
endif
ww = GetBmpWidth(BitmapNumber)
hh = GetBmpHeight(BitmapNumber)
if memblock exist(400) > 0
   delete memblock 400
endif
make memblock from Bitmap 400,BitmapNumber
if alpha < 0
   alpha = 0
endif
if alpha > 255
   alpha = 255
endif
for xxx = 1 to ww
for yyy = 1 to hh
write memblock byte 400,GetBmpPixelLocAlpha(BitmapNumber,xxx,yyy),alpha
next yyy
next xxx
delete Bitmap BitmapNumber
make Bitmap from memblock BitmapNumber,400
delete memblock 400
endfunction

function SetBmpRed(BitmapNumber as integer, red as integer)
if Bitmap exist(BitmapNumber) < 1
   exitfunction
endif
ww = GetBmpWidth(BitmapNumber)
hh = GetBmpHeight(BitmapNumber)
if memblock exist(400) > 0
   delete memblock 400
endif
make memblock from Bitmap 400,BitmapNumber
if red < 0
   red = 0
endif
if red > 255
   red = 255
endif
for xxx = 1 to ww
for yyy = 1 to hh
write memblock byte 400,GetBmpPixelLocRed(BitmapNumber,xxx,yyy),red
next yyy
next xxx
delete Bitmap BitmapNumber
make Bitmap from memblock BitmapNumber,400
delete memblock 400
endfunction

function SetBmpGreen(BitmapNumber as integer, green as integer)
if Bitmap exist(BitmapNumber) < 1
   exitfunction
endif
ww = GetBmpWidth(BitmapNumber)
hh = GetBmpHeight(BitmapNumber)
if memblock exist(400) > 0
   delete memblock 400
endif
make memblock from Bitmap 400,BitmapNumber
if green < 0
   green = 0
endif
if green > 255
   green = 255
endif
for xxx = 1 to ww
for yyy = 1 to hh
write memblock byte 400,GetBmpPixelLocGreen(BitmapNumber,xxx,yyy),green
next yyy
next xxx
delete Bitmap BitmapNumber
make Bitmap from memblock BitmapNumber,400
delete memblock 400
endfunction

function SetBmpBlue(BitmapNumber as integer, blue as integer)
if Bitmap exist(BitmapNumber) < 1
   exitfunction
endif
ww = GetBmpWidth(BitmapNumber)
hh = GetBmpHeight(BitmapNumber)
if memblock exist(400) > 0
   delete memblock 400
endif
make memblock from Bitmap 400,BitmapNumber
if blue < 0
   blue = 0
endif
if blue > 255
   blue = 255
endif
for xxx = 1 to ww
for yyy = 1 to hh
write memblock byte 400,GetBmpPixelLocBlue(BitmapNumber,xxx,yyy),blue
next yyy
next xxx
delete Bitmap BitmapNumber
make Bitmap from memblock BitmapNumber,400
delete memblock 400
endfunction

function SetBmpPixelAlpha(BitmapNumber as integer,xx as integer,yy as integer,colbyte as integer)
if Bitmap exist(BitmapNumber) < 1
   exitfunction
endif
ww = GetBmpWidth(BitmapNumber)
hh = GetBmpHeight(BitmapNumber)
if xx > ww
   xx = ww
endif
if xx < 1
   xx = 1
endif
if yy > hh
   yy = hh
endif
if yy < 1
   yy = 1
endif
if colbyte < 0
   colbyte = 0
endif
if colbyte > 255
   colbyte = 255
endif
loc as integer
loc = GetBmpPixelLocAlpha(BitmapNumber,xx,yy)
if memblock exist(400) > 0
   delete memblock 400
endif
make memblock from Bitmap 400,BitmapNumber
write memblock byte 400,loc,colbyte
delete Bitmap BitmapNumber
make Bitmap from memblock BitmapNumber,400
delete memblock 400
endfunction

function SetBmpPixelRed(BitmapNumber as integer,xx as integer,yy as integer,colbyte as integer)
if Bitmap exist(BitmapNumber) < 1
   exitfunction
endif
ww = GetBmpWidth(BitmapNumber)
hh = GetBmpHeight(BitmapNumber)
if xx > ww
   xx = ww
endif
if xx < 1
   xx = 1
endif
if yy > hh
   yy = hh
endif
if yy < 1
   yy = 1
endif
if colbyte < 0
   colbyte = 0
endif
if colbyte > 255
   colbyte = 255
endif
loc as integer
loc = GetBmpPixelLocRed(BitmapNumber,xx,yy)
if memblock exist(400) > 0
   delete memblock 400
endif
make memblock from Bitmap 400,BitmapNumber
write memblock byte 400,loc,colbyte
delete Bitmap BitmapNumber
make Bitmap from memblock BitmapNumber,400
delete memblock 400
endfunction

function SetBmpPixelGreen(BitmapNumber as integer,xx as integer,yy as integer,colbyte as integer)
if Bitmap exist(BitmapNumber) < 1
   exitfunction
endif
ww = GetBmpWidth(BitmapNumber)
hh = GetBmpHeight(BitmapNumber)
if xx > ww
   xx = ww
endif
if xx < 1
   xx = 1
endif
if yy > hh
   yy = hh
endif
if yy < 1
   yy = 1
endif
if colbyte < 0
   colbyte = 0
endif
if colbyte > 255
   colbyte = 255
endif
loc as integer
loc = GetBmpPixelLocRed(BitmapNumber,xx,yy)
if memblock exist(400) > 0
   delete memblock 400
endif
make memblock from Bitmap 400,BitmapNumber
write memblock byte 400,loc,colbyte
delete Bitmap BitmapNumber
make Bitmap from memblock BitmapNumber,400
delete memblock 400
endfunction

function SetBmpPixelBlue(BitmapNumber as integer,xx as integer,yy as integer,colbyte as integer)
if Bitmap exist(BitmapNumber) < 1
   exitfunction
endif
ww = GetBmpWidth(BitmapNumber)
hh = GetBmpHeight(BitmapNumber)
if xx > ww
   xx = ww
endif
if xx < 1
   xx = 1
endif
if yy > hh
   yy = hh
endif
if yy < 1
   yy = 1
endif
if colbyte < 0
   colbyte = 0
endif
if colbyte > 255
   colbyte = 255
endif
loc as integer
loc = GetBmpPixelLocRed(BitmapNumber,xx,yy)
if memblock exist(400) > 0
   delete memblock 400
endif
make memblock from Bitmap 400,BitmapNumber
write memblock byte 400,loc,colbyte
delete Bitmap BitmapNumber
make Bitmap from memblock BitmapNumber,400
delete memblock 400
endfunction

function SetBmpPixelColour(BitmapNumber as integer,xx as integer,yy as integer,red as byte,green as byte,blue as byte)
if Bitmap exist(BitmapNumber) < 1
   exitfunction
endif
ww = GetBmpWidth(BitmapNumber)
hh = GetBmpHeight(BitmapNumber)
if xx > ww
   xx = ww
endif
if xx < 1
   xx = 1
endif
if yy > hh
   yy = hh
endif
if yy < 1
   yy = 1
endif
locr as integer
locg as integer
locb as integer
locr = GetBmpPixelLocRed(BitmapNumber,xx,yy)
locg = GetBmpPixelLocRed(BitmapNumber,xx,yy)
locb = GetBmpPixelLocRed(BitmapNumber,xx,yy)
if memblock exist(400) > 0
   delete memblock 400
endif
make memblock from Bitmap 400,BitmapNumber
write memblock byte 400,locr,red
write memblock byte 400,locg,green
write memblock byte 400,locb,blue
delete Bitmap BitmapNumber
make Bitmap from memblock BitmapNumber,400
delete memblock 400
endfunction

function ResizeImg(ImageNumber as integer,NewX as integer,NewY as integer)
if image exist(ImageNumber) < 1
   exitfunction
endif
if NewX < 1
   NewX = 1
endif
if NewY < 1
   NewY = 1
endif
if bitmap exist(6) > 0
   delete bitmap 6
endif
create bitmap 6,1024,768
set current bitmap 6
if sprite exist(16000) > 0
   delete sprite 16000
endif
sprite 16000,1,1,ImageNumber
hide sprite 16000
size sprite 16000,NewX,NewY
paste sprite 16000,1,1
delete image ImageNumber
get image ImageNumber,1,1,NewX,NewY,1
delete bitmap 6
delete sprite 16000
set current bitmap 0
endfunction

function VerticalFlipImg(ImageNumber)
if image exist(ImageNumber) < 1
   exitfunction
endif
ww = GetImgWidth(ImageNumber)
hh = GetImgHeight(ImageNumber)
if bitmap exist(6) > 0
   delete bitmap 6
endif
create bitmap 6,1024,768
set current bitmap 6
if sprite exist(16000) > 0
   delete sprite 16000
endif
sprite 16000,1,1,ImageNumber
hide sprite 16000
flip sprite 16000
paste sprite 16000,1,1
delete image ImageNumber
get image ImageNumber,1,1,ww,hh,1
delete bitmap 6
delete sprite 16000
set current bitmap 0
endfunction

function HorizontalFlipImg(ImageNumber)
if image exist(ImageNumber) < 1
   exitfunction
endif
ww = GetImgWidth(ImageNumber)
hh = GetImgHeight(ImageNumber)
if bitmap exist(6) > 0
   delete bitmap 6
endif
create bitmap 6,1024,768
set current bitmap 6
if sprite exist(16000) > 0
   delete sprite 16000
endif
sprite 16000,1,1,ImageNumber
hide sprite 16000
mirror sprite 16000
paste sprite 16000,1,1
delete image ImageNumber
get image ImageNumber,1,1,ww,hh,1
delete bitmap 6
delete sprite 16000
set current bitmap 0
endfunction

function RotateImg(ImageNumber as integer,angle as float)
angle1# = wrapvalue(angle)
if image exist(ImageNumber) < 1
   exitfunction
endif
if bitmap exist(6) > 0
   delete bitmap 6
endif
create bitmap 6,1024,768
set current bitmap 6
if sprite exist(16000) > 0
   delete sprite 16000
endif
sprite 16000,1,1,ImageNumber
hide sprite 16000
rotate sprite 16000,angle1#
paste sprite 16000,1,1
xx = sprite width(16000)
yy = sprite height(16000)
delete image ImageNumber
get image ImageNumber,1,1,xx,yy,1
delete bitmap 6
delete sprite 16000
set current bitmap 0
endfunction

function MergeImgAWithImgB(ImageNumberA as integer,ImageNumberB as integer,ResultantImageC as integer)
if image exist(ImageNumberA) < 1
   exitfunction
endif
if image exist(ImageNumberB) < 1
   exitfunction
endif
if image exist(ResultantImageC) > 0
   delete image ResultantImageC
endif
CopyImg(ImageNumberA,15000)
CopyImg(ImageNumberB,15001)
AWidth = GetImgWidth(ImageNumberA)
BWidth = GetImgWidth(ImageNumberB)
AHeight = GetImgHeight(ImageNumberA)
BHeight = GetImgHeight(ImageNumberB)
ASize = AWidth * AHeight
BSize = BWidth * BHeight
if ASize > BSize
   ResizeImg(ImageNumberB,AWidth,AHeight)
   goto jump1
endif
if BSize > ASize
   ResizeImg(ImageNumberA,BWidth,BHeight)
   goto jump1
endif
ResizeImg(ImageNumberB,AWidth,AHeight)
jump1:
if memblock exist(210) > 0
   delete memblock 210
endif
if memblock exist(211) > 0
   delete memblock 211
endif
if memblock exist(212) > 0
   delete memblock 212
endif
make memblock from image 210,ImageNumberA
make memblock from image 211,ImageNumberB
siz = get memblock size(210)
make memblock 212,siz
www = GetImgWidth(ImageNumberA)
hhh = GetImgHeight(ImageNumberA)
ddd = GetImgDepth(ImageNumberA)
write memblock dword 212,0,www
write memblock dword 212,4,hhh
write memblock dword 212,8,ddd
make image from memblock ResultantImageC,212
for xx = 1 to www
for yy = 1 to hhh
ALocR = GetImgPixelLocRed(ImageNumberA,xx,yy)
ALocG = GetImgPixelLocGreen(ImageNumberA,xx,yy)
ALocB = GetImgPixelLocBlue(ImageNumberA,xx,yy)
ALocA = GetImgPixelLocAlpha(ImageNumberA,xx,yy)
BLocR = GetImgPixelLocRed(ImageNumberB,xx,yy)
BLocG = GetImgPixelLocGreen(ImageNumberB,xx,yy)
BLocB = GetImgPixelLocBlue(ImageNumberB,xx,yy)
BLocA = GetImgPixelLocAlpha(ImageNumberB,xx,yy)
CLocR = ALocR + BLocR / 2
CLocG = ALocG + BLocG / 2
CLocB = ALocB + BLocB / 2
CLocA = ALocA + BLocA / 2
SetImgPixelAlpha(ResultantImageC,xx,yy,CLocA)
SetImgPixelRed(ResultantImageC,xx,yy,CLocR)
SetImgPixelGreen(ResultantImageC,xx,yy,CLocG)
SetImgPixelBlue(ResultantImageC,xx,yy,CLocB)
next yy
next xx
CopyImg(15000,ImageNumberA)
CopyImg(15001,ImageNumberB)
delete memblock 210
delete memblock 211
delete memblock 212
delete image 15000
delete image 15001
endfunction

function ProportionalMergeImgAWithImgB(ImageNumberA as integer,ProportionA as integer,ImageNumberB as integer,ProportionB as integer,ResultantImageC as integer)
if image exist(ImageNumberA) < 1
   exitfunction
endif
if image exist(ImageNumberB) < 1
   exitfunction
endif
if image exist(ResultantImageC) > 0
   delete image ResultantImageC
endif
CopyImg(ImageNumberA,15000)
CopyImg(ImageNumberB,15001)
AWidth = GetImgWidth(ImageNumberA)
BWidth = GetImgWidth(ImageNumberB)
AHeight = GetImgHeight(ImageNumberA)
BHeight = GetImgHeight(ImageNumberB)
ASize = AWidth * AHeight
BSize = BWidth * BHeight
if ASize > BSize
   ResizeImg(ImageNumberB,AWidth,AHeight)
   goto jump1
endif
if BSize > ASize
   ResizeImg(ImageNumberA,BWidth,BHeight)
   goto jump1
endif
ResizeImg(ImageNumberB,AWidth,AHeight)
jump1:
if memblock exist(210) > 0
   delete memblock 210
endif
if memblock exist(211) > 0
   delete memblock 211
endif
if memblock exist(212) > 0
   delete memblock 212
endif
make memblock from image 210,ImageNumberA
make memblock from image 211,ImageNumberB
siz = get memblock size(210)
make memblock 212,siz
www = GetImgWidth(ImageNumberA)
hhh = GetImgHeight(ImageNumberA)
ddd = GetImgDepth(ImageNumberA)
write memblock dword 212,0,www
write memblock dword 212,4,hhh
write memblock dword 212,8,ddd
make image from memblock ResultantImageC,212
for xx = 1 to www
for yy = 1 to hhh
ALocR = GetImgPixelLocRed(ImageNumberA,xx,yy)
ALocG = GetImgPixelLocGreen(ImageNumberA,xx,yy)
ALocB = GetImgPixelLocBlue(ImageNumberA,xx,yy)
ALocA = GetImgPixelLocAlpha(ImageNumberA,xx,yy)
BLocR = GetImgPixelLocRed(ImageNumberB,xx,yy)
BLocG = GetImgPixelLocGreen(ImageNumberB,xx,yy)
BLocB = GetImgPixelLocBlue(ImageNumberB,xx,yy)
BLocA = GetImgPixelLocAlpha(ImageNumberB,xx,yy)
TotalP = ProportionA + ProportionB
CLocR = (ALocR * ProportionA) + (BLocR * ProportionB) / TotalP / 2
CLocG = (ALocG * ProportionA) + (BLocG * ProportionB) / TotalP / 2
CLocB = (ALocB * ProportionA) + (BLocB * ProportionB) / TotalP / 2
CLocA = (ALocA * ProportionA) + (BLocA * ProportionB) / TotalP / 2
SetImgPixelAlpha(ResultantImageC,xx,yy,CLocA)
SetImgPixelRed(ResultantImageC,xx,yy,CLocR)
SetImgPixelGreen(ResultantImageC,xx,yy,CLocG)
SetImgPixelBlue(ResultantImageC,xx,yy,CLocB)
next yy
next xx
CopyImg(15000,ImageNumberA)
CopyImg(15001,ImageNumberB)
delete memblock 210
delete memblock 211
delete memblock 212
delete image 15000
delete image 15001
endfunction

function MakeImgGreyscale(ImageNumber as integer)
if image exist(ImageNumber) < 1
   exitfunction
endif
ww = GetImgWidth(ImageNumber)
hh = GetImgHeight(ImageNumber)
for x = 1 to ww
for y = 1 to hh
rr = GetImgPixelRed(ImageNumber,x,y)
gg = GetImgPixelGreen(ImageNumber,x,y)
bb = GetImgPixelBlue(ImageNumber,x,y)
tt = rr + gg + bb / 3
SetImgPixelColour(ImageNumber,x,y,tt,tt,tt)
next y
next x
endfunction

function MakeImgRedscale(ImageNumber as integer)
if image exist(ImageNumber) < 1
   exitfunction
endif
ww = GetImgWidth(ImageNumber)
hh = GetImgHeight(ImageNumber)
for x = 1 to ww
for y = 1 to hh
rr = GetImgPixelRed(ImageNumber,x,y)
gg = GetImgPixelGreen(ImageNumber,x,y)
bb = GetImgPixelBlue(ImageNumber,x,y)
tt = rr + gg + bb / 3
SetImgPixelColour(ImageNumber,x,y,tt,0,0)
next y
next x
endfunction

function MakeImgGreenscale(ImageNumber as integer)
if image exist(ImageNumber) < 1
   exitfunction
endif
ww = GetImgWidth(ImageNumber)
hh = GetImgHeight(ImageNumber)
for x = 1 to ww
for y = 1 to hh
rr = GetImgPixelRed(ImageNumber,x,y)
gg = GetImgPixelGreen(ImageNumber,x,y)
bb = GetImgPixelBlue(ImageNumber,x,y)
tt = rr + gg + bb / 3
SetImgPixelColour(ImageNumber,x,y,0,tt,0)
next y
next x
endfunction

function MakeImgBluescale(ImageNumber as integer)
if image exist(ImageNumber) < 1
   exitfunction
endif
ww = GetImgWidth(ImageNumber)
hh = GetImgHeight(ImageNumber)
for x = 1 to ww
for y = 1 to hh
aa = GetImgPixelAlpha(ImageNumber,x,y)
rr = GetImgPixelRed(ImageNumber,x,y)
gg = GetImgPixelGreen(ImageNumber,x,y)
bb = GetImgPixelBlue(ImageNumber,x,y)
tt = rr + gg + bb / 3
SetImgPixelColour(ImageNumber,x,y,0,0,tt)
next y
next x
endfunction

function IncreaseImgAlpha(ImageNumber as integer,Percentage as integer)
if image exist(ImageNumber) < 1
   exitfunction
endif
ww = GetImgWidth(ImageNumber)
hh = GetImgHeight(ImageNumber)
for x = 1 to ww
for y = 1 to hh
aa = GetImgPixelAlpha(ImageNumber,x,y)
aaa = 255 - aa
aaaa# = aaa / 100
aaaaa# = aaaa# * Percentage
aa1 = int(aaaaa#)
SetImgPixelAlpha(ImageNumber,x,y,aa1)
next y
next x
endfunction

function DecreaseImgAlpha(ImageNumber as integer,Percentage as integer)
if image exist(ImageNumber) < 1
   exitfunction
endif
ww = GetImgWidth(ImageNumber)
hh = GetImgHeight(ImageNumber)
for x = 1 to ww
for y = 1 to hh
aa = GetImgPixelAlpha(ImageNumber,x,y)
aaa = aa
aaaa# = aaa / 100
aaaaa# = aaaa# * Percentage
aa1 = aaa - int(aaaaa#)
SetImgPixelAlpha(ImageNumber,x,y,aa1)
next y
next x
endfunction

function IncreaseImgRed(ImageNumber as integer,Percentage as integer)
if image exist(ImageNumber) < 1
   exitfunction
endif
ww = GetImgWidth(ImageNumber)
hh = GetImgHeight(ImageNumber)
for x = 1 to ww
for y = 1 to hh
aa = GetImgPixelRed(ImageNumber,x,y)
aaa = 255 - aa
aaaa# = aaa / 100
aaaaa# = aaaa# * Percentage
aa1 = int(aaaaa#)
SetImgPixelRed(ImageNumber,x,y,aa1)
next y
next x
endfunction

function DecreaseImgRed(ImageNumber as integer,Percentage as integer)
if image exist(ImageNumber) < 1
   exitfunction
endif
ww = GetImgWidth(ImageNumber)
hh = GetImgHeight(ImageNumber)
for x = 1 to ww
for y = 1 to hh
aa = GetImgPixelRed(ImageNumber,x,y)
aaa = aa
aaaa# = aaa / 100
aaaaa# = aaaa# * Percentage
aa1 = aaa - int(aaaaa#)
SetImgPixelRed(ImageNumber,x,y,aa1)
next y
next x
endfunction

function IncreaseImgGreen(ImageNumber as integer,Percentage as integer)
if image exist(ImageNumber) < 1
   exitfunction
endif
ww = GetImgWidth(ImageNumber)
hh = GetImgHeight(ImageNumber)
for x = 1 to ww
for y = 1 to hh
aa = GetImgPixelGreen(ImageNumber,x,y)
aaa = 255 - aa
aaaa# = aaa / 100
aaaaa# = aaaa# * Percentage
aa1 = int(aaaaa#)
SetImgPixelGreen(ImageNumber,x,y,aa1)
next y
next x
endfunction

function DecreaseImgGreen(ImageNumber as integer,Percentage as integer)
if image exist(ImageNumber) < 1
   exitfunction
endif
ww = GetImgWidth(ImageNumber)
hh = GetImgHeight(ImageNumber)
for x = 1 to ww
for y = 1 to hh
aa = GetImgPixelGreen(ImageNumber,x,y)
aaa = aa
aaaa# = aaa / 100
aaaaa# = aaaa# * Percentage
aa1 = aaa - int(aaaaa#)
SetImgPixelGreen(ImageNumber,x,y,aa1)
next y
next x
endfunction

function IncreaseImgBlue(ImageNumber as integer,Percentage as integer)
if image exist(ImageNumber) < 1
   exitfunction
endif
ww = GetImgWidth(ImageNumber)
hh = GetImgHeight(ImageNumber)
for x = 1 to ww
for y = 1 to hh
aa = GetImgPixelBlue(ImageNumber,x,y)
aaa = 255 - aa
aaaa# = aaa / 100
aaaaa# = aaaa# * Percentage
aa1 = int(aaaaa#)
SetImgPixelBlue(ImageNumber,x,y,aa1)
next y
next x
endfunction

function DecreaseImgBlue(ImageNumber as integer,Percentage as integer)
if image exist(ImageNumber) < 1
   exitfunction
endif
ww = GetImgWidth(ImageNumber)
hh = GetImgHeight(ImageNumber)
for x = 1 to ww
for y = 1 to hh
aa = GetImgPixelBlue(ImageNumber,x,y)
aaa = aa
aaaa# = aaa / 100
aaaaa# = aaaa# * Percentage
aa1 = aaa - int(aaaaa#)
SetImgPixelBlue(ImageNumber,x,y,aa1)
next y
next x
endfunction

some of you may find it of some use.... some not.

a long time dabbler with DBC and DBPro with no actual talent but lots of enthusiasm...

Back to top

Profile PM Email

Scraggle

Moderator

21

Years of Service

User Offline

Joined: 10th Jul 2003

Location: Yorkshire

Posted: 25th Sep 2006 01:35 Edited at: 25th Sep 2006 01:48

Link

Some folk may find some of those functions useful. However, I noticed that you often check to see if memblock 100 (or 200(or 300(or 400))) exists and if it does then you delete it because your function needs it!
May I suggest that you search for a free memblock instead of deleting a memblock that the user (or in this case - coder) may find vitally useful and really doesn't want to be deleted.

+ Code Snippet

Function FreeMemBlock()
	
	Mb = 1
	repeat
		if Memblock Exist(Mb) = 0
			Found = 1
		else
			inc Mb
		endif
	until Found
	
EndFunction Mb

Also, your function to copy a bitmap already exists as a DBP command. Check out the Copy Bitmap command (it also allows images to be scaled it the bitmaps are of unequal sizes).

Back to top

Profile PM Email

Duffer

21

Years of Service

User Offline

Joined: 9th Feb 2003

Location: chair

Posted: 25th Sep 2006 10:08

Link

@ Scraggle,

Thanks for the feedback. You're quite right. Made the memblock numbers very high so as to avoid program memblocks. However, could do a search routine (within a certain bracket) for free memblocks. Actually, now I seem to think about it IanM had a free dll to do just that...

I suppose the notional programmer could adjust the memblock numbers as well to suit.

With the CopyBmp command I was just getting carried away.

Before I got going on this I was really just after a few commands to allow me to draw or get colour at pixel within images...

Just a thought - if I alter an image using the above functions, what happens to that same image as utilised in a sprite - (is the image data in the sprite now independent)? if yes, thought so, if no, couldnt I write a function for sprite collision?

a long time dabbler with DBC and DBPro with no actual talent but lots of enthusiasm...

Back to top

Profile PM Email

Oneka

20

Years of Service

User Offline

Joined: 24th Apr 2004

Location: Hampton,VA

Posted: 25th Sep 2006 23:25

Link

Nice set of commands Duffer

Making better games everday!
Oh yeah and just so you know its Oh-nek-a not One-ka!

Back to top

Profile PM Email Website

Azrael

19

Years of Service

User Offline

Joined: 2nd Mar 2005

Location: Germany

Posted: 27th Sep 2006 23:29

Link

A fast way of finding a free memblock..

+ Code Snippet

MemB As Integer

Repeat
  MemB = rnd(1000) + 1000
Until not memblock exist(MemB)

Thanks for this set of functions anyway - takes me a lot of work.

Back to top

Profile PM Email Website

Duffer

21

Years of Service

User Offline

Joined: 9th Feb 2003

Location: chair

Posted: 28th Sep 2006 22:14

Link

@ Azrael,

Cool - thanks

a long time dabbler with DBC and DBPro with no actual talent but lots of enthusiasm...

Back to top

Profile PM Email

dark coder

22

Years of Service

User Offline

Joined: 6th Oct 2002

Location: Japan

Posted: 29th Sep 2006 11:53

Link

Or a method that doesn't rely on random numbers

+ Code Snippet

Function FreeMemblock()
   Repeat
      Inc Ret
   Until Memblock Exist(Ret) = 0
EndFunction Ret

Hallowed are the ori.

Back to top

Profile PM Email

Sorry your browser is not supported!

Work in Progress / Tinkering about with Images (and Bitmaps) using Memblocks....