KeyImage

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

KeyImage by skidracer (Posted 22 years ago)
This code resets the masked pixels of a Texture to the given keycolor then corrects the edge color of any transparent texels to the average of any solid neighbors.
Function KeyImage(texture,keycolor) oldbuffer=GraphicsBuffer() buffer=TextureBuffer(texture) SetBuffer buffer LockBuffer buffer w=GraphicsWidth() h=GraphicsHeight() keycolor=keycolor And $fcfcfc ; first pass set key For y=0 To h-1 For x=0 To w-1 c=ReadPixelFast(x,y) If (c And $fcfcfc)<>keycolor c=c Or $ff000000 Else c=0 EndIf WritePixelFast x,y,c Next Next ; second pass fix edges For y=1 To h-2 For x=1 To w-2 c=ReadPixelFast(x,y) If c=0 t=0 For yy=-1 To 1 For xx=-1 To 1 c=ReadPixelFast(x+xx,y+yy) If c and $ffffff t=((t And $fefefe) Shr 1)+((c And $fefefe) Shr 1) EndIf Next Next WritePixelFast x+xx,y+yy,t EndIf Next Next UnlockBuffer buffer SetBuffer oldbuffer End Function

(Posted 22 years ago)

This code resets the masked pixels of a Texture to the given keycolor then corrects the edge color of any transparent texels to the average of any solid neighbors.

Function KeyImage(texture,keycolor)
	oldbuffer=GraphicsBuffer() 
	buffer=TextureBuffer(texture)
	SetBuffer buffer
	LockBuffer buffer	
	w=GraphicsWidth()
	h=GraphicsHeight()
	keycolor=keycolor And $fcfcfc
; first pass set key
	For y=0 To h-1
		For x=0 To w-1
			c=ReadPixelFast(x,y)
			If (c And $fcfcfc)<>keycolor
				c=c Or $ff000000
			Else
				c=0
			EndIf
			WritePixelFast x,y,c
		Next
	Next
; second pass fix edges
	For y=1 To h-2
		For x=1 To w-2
			c=ReadPixelFast(x,y)
			If c=0
				t=0
				For yy=-1 To 1
					For xx=-1 To 1
						c=ReadPixelFast(x+xx,y+yy)
						If c and $ffffff
							t=((t And $fefefe) Shr 1)+((c And $fefefe) Shr 1)
						EndIf
					Next
				Next			
				WritePixelFast x+xx,y+yy,t
			EndIf
		Next
	Next
	UnlockBuffer buffer
	SetBuffer oldbuffer
End Function