Unique Colour Counter

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

Unique Colour Counter by Snarty

2003

This function will step through a 24bit image (Created with Flag 4) and return the amount of colours in the image. This will be useful for building palette lists for colour operations.. etc.

Dim RG(255,255)

Function CountColours(Parent,Image)

	UpWin=CreateWindow("Analysing Image...",GadgetX(Parent)+((GadgetWidth(Parent)-240)/2),GadgetY(Parent)+((GadgetHeight(Parent)-60)/2),240,60,Parent,17)
	Progbar=CreateProgBar(4,4,ClientWidth(UpWin)-8,ClientHeight(UpWin)-8,UpWin,1)
	Buffer=ImageBuffer(Image)
	LockBuffer Buffer
	BBank=LockedPixels(Buffer)
	BPitch=LockedPitch(Buffer)
	SH#=ImageBuffer(Image)
	For y=0 To ImageHeight(Image)-1
		yoff=y*BPitch
		For x=0 To ImageWidth(Image)-1
			pyxoff=yoff+(x*3)
			Rd=PeekByte(BBank,pyxoff+2)
			Gr=PeekByte(BBank,pyxoff+1)
			Bl=PeekByte(BBank,pyxoff)
			If RG(Rd,Gr)
				If Not PeekByte(RG(Rd,Gr),Bl)
					PokeByte RG(Rd,Gr),Bl,1
					NumCols=NumCols+1
				EndIf
			Else
				RG(Rd,Gr)=CreateBank(256)
				PokeByte RG(Rd,Gr),Bl,1
				NumCols=NumCols+1
			EndIf
		Next
		UpdateProgBar ProgBar,y/SH
	Next
	UnlockBuffer Buffer
	For r=0 To 255
		For g=0 To 255
			If RG(r,g)
				FreeBank RG(r,g)
				RG(r,g)=0
			EndIf
		Next
	Next
	FreeGadget UpWin
	Return NumCols

End Function

Comments

None.

Code Archives Forum