[bb] Unique Colour Counter by Snarty [ 1+ years ago ]

[BlitzBot]

Title : Unique Colour Counter
Author : Snarty
Posted : 1+ years ago

Description : 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.

Code :

Code: BlitzBasic

1. Dim RG(255,255)
2.  
3. Function CountColours(Parent,Image)
4.  
5.         UpWin=CreateWindow("Analysing Image...",GadgetX(Parent)+((GadgetWidth(Parent)-240)/2),GadgetY(Parent)+((GadgetHeight(Parent)-60)/2),240,60,Parent,17)
6.         Progbar=CreateProgBar(4,4,ClientWidth(UpWin)-8,ClientHeight(UpWin)-8,UpWin,1)
7.         Buffer=ImageBuffer(Image)
8.         LockBuffer Buffer
9.         BBank=LockedPixels(Buffer)
10.         BPitch=LockedPitch(Buffer)
11.         SH#=ImageBuffer(Image)
12.         For y=0 To ImageHeight(Image)-1
13.                 yoff=y*BPitch
14.                 For x=0 To ImageWidth(Image)-1
15.                         pyxoff=yoff+(x*3)
16.                         Rd=PeekByte(BBank,pyxoff+2)
17.                         Gr=PeekByte(BBank,pyxoff+1)
18.                         Bl=PeekByte(BBank,pyxoff)
19.                         If RG(Rd,Gr)
20.                                 If Not PeekByte(RG(Rd,Gr),Bl)
21.                                         PokeByte RG(Rd,Gr),Bl,1
22.                                         NumCols=NumCols+1
23.                                 EndIf
24.                         Else
25.                                 RG(Rd,Gr)=CreateBank(256)
26.                                 PokeByte RG(Rd,Gr),Bl,1
27.                                 NumCols=NumCols+1
28.                         EndIf
29.                 Next
30.                 UpdateProgBar ProgBar,y/SH
31.         Next
32.         UnlockBuffer Buffer
33.         For r=0 To 255
34.                 For g=0 To 255
35.                         If RG(r,g)
36.                                 FreeBank RG(r,g)
37.                                 RG(r,g)=0
38.                         EndIf
39.                 Next
40.         Next
41.         FreeGadget UpWin
42.         Return NumCols
43.  
44. End Function

Comments : none...