Code archives/Graphics/Image Processing Functions

This code has been declared by its author to be Public Domain code.

Download source code

Image Processing Functions by Myke-P2001
Image Processing Functions: More to come as they're completed. Next time 'round I'll have over commented these and the successive jobbies for all you Image Processing junkies! :)

Oh.. You'll need to provide a picture (currently called "TestIn.bmp" in the current folder) for these to work!

Probably not fast enough for real-time on-screen effects (sadly) but feel free to optimize them. Aside from that, feel free to use them, expand upon them and generally enjoy them in any way you see fit! If you do something similar or even better (can't be hard!) then share them with us too!
;Image Functions by Myke-P 2001
;various PixelFast functions that do funky things to images.
;Thanks to John C and Rob Cummings for their invaluable help.

AppTitle "Image Functions by Myke-P 2001"
Graphics 640,480,0,2
Global sourceimage = LoadImage("TestIn.bmp")
Global destinimage
Dim floydsarray#(0,0)

starttime = MilliSecs()

;uncomment one at a time, as appropriate, for a demo,
;otherwise you'll get the dreaded "illegal memory address"! :)

;destinimage = Image_Greyscale(sourceimage)
;destinimage = Image_Pixelate(sourceimage,5,5,2)
;destinimage = Image_Scanline(sourceimage,100,1)
;destinimage = Image_Colourise(sourceimage,255,0,255,1)
;destinimage = Image_Brightness(sourceimage,80,50)
;destinimage = Image_Negative(sourceimage)
;destinimage = Image_FloydDither(sourceimage)

endtime = MilliSecs()
SaveBuffer (ImageBuffer(destinimage),"TestOut.bmp")
SetBuffer FrontBuffer()
DrawBlock destinimage,0,20
DrawBlock sourceimage,ImageWidth(destinimage),20
Text 0,0,"That took: " + (endtime-starttime) + " millisecs."
WaitKey()
End

;IMAGE_GREYSCALE
;Turns an image into hues of Grey.
;
;source = source image handle
Function Image_Greyscale(source)
currbuff = GraphicsBuffer()
destin = CopyImage (source)
SetBuffer ImageBuffer(destin)
LockBuffer()
For i = 0 To ImageWidth(destin)-1
	For j = 0 To ImageHeight(destin)-1
		col = ReadPixelFast(i,j) And $FFFFFF
		redlevel = (col Shr 16) And $FF
		greenlevel = (col Shr 8) And $FF
		bluelevel = col And $FF
		greylevel = Int(0.298039215 * redlevel) + Int(0.588235293 * greenlevel) + Int(0.109803921 * bluelevel)
		argb = (greylevel Or (greylevel Shl 8) Or (greylevel Shl 16) Or (255 Shl 24))
		WritePixelFast i,j,argb
	Next
Next
UnlockBuffer()
SetBuffer currbuff
Return destin
End Function

;IMAGE_PIXELATE
;Turns an image into chunky pixels (size of your choice)
;
;source = source image handle
;x = width of pixelation
;y = height of pixelation
;option = 1: averaging off (default), 2: averaging on
Function Image_Pixelate(source,x,y,option)
currbuff = GraphicsBuffer()
If option <> 1 And option <> 2 Then
	option = 1
End If
destin = CopyImage(source)
SetBuffer ImageBuffer(destin)
LockBuffer()
Select option
	Case 1
		i = 0
		While i <= ImageWidth(destin)-1
			j = 0
			While j <= ImageHeight(destin)-1
				col = ReadPixelFast(i,j) And $FFFFFF
				redlevel = (col Shr 16) And $FF
				greenlevel = (col Shr 8) And $FF
				bluelevel = col And $FF
				argb = (bluelevel Or (greenlevel Shl 8) Or (redlevel Shl 16) Or (255 Shl 24))
				For k = 0 To x-1
					For l = 0 To y-1
						If ((i+k) < ImageWidth(destin)) And ((j+l) < ImageHeight(destin)) Then
							WritePixelFast (i+k),(j+l),argb
						End If
					Next
				Next
				j = j + y
			Wend
			i = i + x
		Wend
	Case 2
		i = 0
		While i <= ImageWidth(destin)-1
			j = 0
			While j <= ImageHeight(destin)-1
				redlevel = 0
				greenlevel = 0
				bluelevel = 0
				numpixels = 0
				;pass one - add all the r, g and b values together
				For k = 0 To x-1
					For l = 0 To y-1
						If ((i+k) < ImageWidth(destin)) And ((j+l) < ImageHeight(destin)) Then
							col = ReadPixelFast(i+k,j+l) And $FFFFFF
							redlevel = redlevel + ((col Shr 16) And $FF)
							greenlevel = greenlevel + ((col Shr 8) And $FF)
							bluelevel = bluelevel + (col And $FF)
							numpixels = numpixels + 1
						End If
					Next
				Next
				;work out the average r, g and b values by deviding by the number of counted pixels in the x*y block
				redlevel = Int(redlevel/numpixels)
				greenlevel = Int(greenlevel/numpixels)
				bluelevel = Int(bluelevel/numpixels)
				argb = (bluelevel Or (greenlevel Shl 8) Or (redlevel Shl 16) Or (255 Shl 24))
				;pass two - draw pixels of that colour
				For k = 0 To x-1
					For l = 0 To y-1
						If ((i+k) < ImageWidth(destin)) And ((j+l) < ImageHeight(destin)) Then
							WritePixelFast (i+k),(j+l),argb
						End If
					Next
				Next
				j = j + y
			Wend
			i = i + x
		Wend
End Select
UnlockBuffer()
SetBuffer currbuff
Return destin
End Function

;IMAGE_SCANLINE
;Adds a scanline effect on alternate lines (intensity and h/v direction of your choice)
;
;source = source image handle
;intensity = 0 to 100% as an integer
;option = 1: horizontal (default), 2: vertical
Function Image_Scanline(source,intensity#,option)
currbuff = GraphicsBuffer()
If intensity > 100 Then
	intensity = 100
Else If intensity < 0 Then
	intensity = 0
End If
intensity# = 1+(intensity/100)
If option <> 1 And option <> 2 Then
	option = 1
End If
destin = CopyImage (source)
SetBuffer ImageBuffer(destin)
LockBuffer()
Select option
	Case 2	;vertical
		For i = 0 To ImageWidth(destin)-1 Step 2
			For j = 0 To ImageHeight(destin)-1
				col = ReadPixelFast(i,j) And $FFFFFF
				redlevel = ((col Shr 16) And $FF) / intensity
				greenlevel = ((col Shr 8) And $FF) / intensity
				bluelevel = (col And $FF) / intensity
				argb = (bluelevel Or (greenlevel Shl 8) Or (redlevel Shl 16) Or (255 Shl 24))
				WritePixelFast i,j,argb
			Next
		Next
	Default	;horizontal
		For i = 0 To ImageWidth(destin)-1
			For j = 0 To ImageHeight(destin)-1 Step 2
				col = ReadPixelFast(i,j) And $FFFFFF
				redlevel = ((col Shr 16) And $FF) / intensity
				greenlevel = ((col Shr 8) And $FF) / intensity
				bluelevel = (col And $FF) / intensity
				argb = (bluelevel Or (greenlevel Shl 8) Or (redlevel Shl 16) Or (255 Shl 24))
				WritePixelFast i,j,argb
			Next
		Next
End Select
UnlockBuffer()
SetBuffer currbuff
Return destin
End Function

;IMAGE_COLOURISE
;Turns an image into hues of an RGB colour of your chosing (2 modes)
;
;source = source image handle
;red, green, blue = RGB values to aim toward
;option = 1: true colourise ala PSP (default), 2: alternate colourise 
Function Image_Colourise(source,red#,green#,blue#,option)
currbuff = GraphicsBuffer()
red# = red#/255
green# = green#/255
blue# = blue#/255
If option <> 1 And option <> 2 Then
	option = 1
End If

destin = CopyImage (source)
SetBuffer ImageBuffer(destin)
LockBuffer()
For i = 0 To ImageWidth(destin)-1
	For j = 0 To ImageHeight(destin)-1
		col = ReadPixelFast(i,j) And $FFFFFF
		redlevel = (col Shr 16) And $FF
		greenlevel = (col Shr 8) And $FF
		bluelevel = col And $FF
		greylevel = Int(0.298039215 * redlevel) + Int(0.588235293 * greenlevel) + Int(0.109803921 * bluelevel)
		Select option
			Case 2	;alternate colourise
				redlevel = Int(greylevel*red)
				greenlevel = Int(greylevel*green)
				bluelevel = Int(bluelevel*blue)
			Default	;true colorise (PSP emulation)
				If greylevel >= 128 Then
					redlevel = 255 * red + (1-red)*(greylevel-(255-greylevel))
					greenlevel = 255 * green + (1-green)*(greylevel-(255-greylevel))
					bluelevel = 255 * blue + (1-blue)*(greylevel-(255-greylevel))
				Else
					redlevel = Int(greylevel*red)*2
					greenlevel = Int(greylevel*green)*2
					bluelevel = Int(greylevel*blue)*2
				End If
		End Select
		argb = (bluelevel Or (greenlevel Shl 8) Or (redlevel Shl 16) Or (255 Shl 24))
		WritePixelFast i,j,argb
	Next
Next
UnlockBuffer()
SetBuffer currbuff
Return destin
End Function

;IMAGE_BRIGHTNESS
;Alters an images brightness and contrast
;
;NOTES: contrast equation not 100% accurate, but a bloody close approximation! ;)
;
;source = source image handle
;brightness = RGB level offset in the range -255 to 255
;contrast = contrast in the range -100% to 100% as an integer
Function Image_Brightness(source,brightness,contrast#)
currbuff = GraphicsBuffer()
destin = CopyImage (source)
If contrast# > 100 Then
	contrast# = 100
Else If contrast# < -100 Then
	contrast# = -100
End If
If contrast# >= 0 Then
	contrast# = (contrast#/(101-contrast#))
Else
	contrast# = (0-(contrast#/50))*(contrast#/(101-contrast#))
End If
SetBuffer ImageBuffer(destin)
LockBuffer()
For i = 0 To ImageWidth(destin)-1
	For j = 0 To ImageHeight(destin)-1
		col = ReadPixelFast(i,j) And $FFFFFF
		redlevel = (col Shr 16) And $FF
		greenlevel = (col Shr 8) And $FF
		bluelevel = col And $FF
		If contrast <= 0 Then
			If redlevel < 128 Then
				redlevel = Int(redlevel - (127-redlevel)*contrast) + brightness
			Else
				redlevel = Int(redlevel + (redlevel-127)*contrast) + brightness
			End If
			If greenlevel < 128 Then
				greenlevel = Int(greenlevel - (127-greenlevel)*contrast) + brightness
			Else
				greenlevel = Int(greenlevel + (greenlevel-127)*contrast) + brightness
			End If
			If bluelevel < 128 Then
				bluelevel = Int(bluelevel - (127-bluelevel)*contrast) + brightness
			Else
				bluelevel = Int(bluelevel + (bluelevel-127)*contrast) + brightness
			End If
		Else
			If redlevel < 128 Then
				redlevel = Int(redlevel + brightness)
				redlevel = redlevel - (127-redlevel)*contrast
			Else
				redlevel = Int(redlevel + brightness)
				redlevel = redlevel + (redlevel-127)*contrast
			End If
			If greenlevel < 128 Then
				greenlevel = Int(greenlevel + brightness)
				greenlevel = greenlevel - (127-greenlevel)*contrast
			Else
				greenlevel = Int(greenlevel + brightness)
				greenlevel = greenlevel + (greenlevel-127)*contrast
			End If
			If bluelevel < 128 Then
				bluelevel = Int(bluelevel + brightness)
				bluelevel = bluelevel - (127-bluelevel)*contrast
			Else
				bluelevel = Int(bluelevel + brightness)
				bluelevel = bluelevel + (bluelevel-127)*contrast
			End If
		End If
		If redlevel > 255 Then
			redlevel = 255
		End If
		If redlevel < 0 Then
			redlevel = 0
		End If
		If greenlevel > 255 Then
			greenlevel = 255
		End If
		If greenlevel < 0 Then
			greenlevel = 0
		End If
		If bluelevel > 255 Then
			bluelevel = 255
		End If
		If bluelevel < 0 Then
			bluelevel = 0
		End If
		
		argb = (bluelevel Or (greenlevel Shl 8) Or (redlevel Shl 16) Or (255 Shl 24))
		WritePixelFast i,j,argb
	Next
Next
UnlockBuffer()
SetBuffer currbuff
Return destin
End Function

;IMAGE_NEGATIVE
;Turns an image into it's negative form.
;
;source = source image handle
Function Image_Negative(source)
currbuff = GraphicsBuffer()
destin = CopyImage (source)
SetBuffer ImageBuffer(destin)
LockBuffer()
For i = 0 To ImageWidth(destin)-1
	For j = 0 To ImageHeight(destin)-1
		col = ReadPixelFast(i,j) And $FFFFFF
		redlevel = 255-((col Shr 16) And $FF)
		greenlevel = 255-((col Shr 8) And $FF)
		bluelevel = 255-(col And $FF)
		argb = (bluelevel Or (greenlevel Shl 8) Or (redlevel Shl 16) Or (255 Shl 24))
		WritePixelFast i,j,argb
	Next
Next
UnlockBuffer()
SetBuffer currbuff
Return destin
End Function

;IMAGE_FLOYDDITHER
;Dithers an image using Floyd-Steinberg approximation into 2 colours
;
;source = source image handle
;optional parameters (defaults given will be used if omitted)
;erroroffset = multiplier for error#
;redhigh,greenhigh,bluehigh = RGB values for light pixels
;redlow,greenlow,bluelow = RGB values for dark pixels
Function Image_FloydDither(source,erroroffset#=1,redhigh=255,greenhigh=255,bluehigh=255,redlow=0,greenlow=0,bluelow=0)
currbuff = GraphicsBuffer()
destin = CopyImage (source)
Dim floydsarray#(ImageWidth(destin),ImageHeight(destin))
SetBuffer ImageBuffer(destin)
LockBuffer()
;pass one - read greylevels into array
For i = 0 To ImageWidth(destin)-1
	For j = 0 To ImageHeight(destin)-1
		col = ReadPixelFast(i,j) And $FFFFFF
		redlevel = (col Shr 16) And $FF
		greenlevel = (col Shr 8) And $FF
		bluelevel = col And $FF
		greylevel# = Int(((222 * redlevel) + (707 * greenlevel) + (71 * bluelevel))/1000)
		floydsarray(i,j) = greylevel#/255
		argb = (greylevel Or (greylevel Shl 8) Or (greylevel Shl 16) Or (255 Shl 24))
		WritePixelFast i,j,argb
	Next
Next
;pass two - dither based on greylevels
For i = 0 To ImageWidth(destin)-1
	For j = 0 To ImageHeight(destin)-1
		If floydsarray(i,j) < 0.5 Then
			bright = 0
		Else
			bright = 1
		End If
		error# = erroroffset*(floydsarray(i,j) - bright)
		If (j+1 <= ImageHeight(destin)-1) Then
			floydsarray(i,j+1) = floydsarray(i,j+1) + error#*7/16
		End If
		If j-1 >=0 Then
			If (i+1 <= ImageWidth(destin)-1) Then
				floydsarray(i+1,j-1) = floydsarray(i+1,j-1) + error#*3/16
			End If
		End If
		If (i+1 <= ImageWidth(destin)-1) Then
			floydsarray(i+1,j) = floydsarray(i+1,j) + error#*5/16
		End If
		If (i+1 <= ImageWidth(destin)-1) And (j+1 <= ImageHeight(destin)-1) Then
			floydsarray(i+1,j+1) = floydsarray(i+1,j+1) + error#*1/16
		End If
	Next
Next
;pass three - write white or black pixels from array
For i = 0 To ImageWidth(destin)-1
	For j = 0 To ImageHeight(destin)-1
		If floydsarray(i,j) > 1 Then
			floydsarray(i,j) = 1
		ElseIf floydsarray(i,j) < 0 Then
			floydsarray(i,j) = 0
		End If
		If floydsarray(i,j) < 0.5 Then
			argb = (bluelow Or (greenlow Shl 8) Or (redlow Shl 16) Or (255 Shl 24))
		Else
			argb = (bluehigh Or (greenhigh Shl 8) Or (redhigh Shl 16) Or (255 Shl 24))
		End If
		WritePixelFast i,j,argb
	Next
Next
UnlockBuffer()
SetBuffer currbuff
Return destin
End Function

Comments

None.

Code Archives Forum