TheGameCreators - CodeBase - Tinkering about with images and bitmaps using memblocks

Return to the CodeBase listing

Category: Image

Version: 1.0

Information

Uploaded: 24th Sep 2006 17:11

Modified: 1st Jan 1970 01:00

Author: Duffer

Summary

using memblocks to tinker around with images and bitmaps at pixel level

Full Description

fairly self-explanatory really...

DarkBASIC Professional Source Code

` This code was downloaded from The Game Creators

` It is reproduced here with full permission

` http://www.thegamecreators.com

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

Download

Please login to download

Comments

No comments yet.

CodeBase - Tinkering about with images and bitmaps using memblocks - at pixel level

Information

Summary

Full Description

DarkBASIC Professional Source Code

Download

Screen Shot

Author

Comments

Author Name:	Duffer
CodeBase Entries:	4