Unique colors counter for any picture.

Aim of this project
This Project count unique color from any image.

Main Title: Image Recognition
Project: Unique colors counter for any picture.
Developer: Md. Redwanur Rahman
Location: Dhaka, Bangladesh.
Date: 30 October, 2007

I am here to share idea with other.

Program Details

Start Here…………………………………

Option Explicit

Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" ( _
lpvDest As Any, lpvSource As Any, ByVal cbCopy As Long)

Private Type SAFEARRAYBOUND
cElements As Long
lLbound As Long
End Type
Private Type SAFEARRAY2D
cDims As Integer
fFeatures As Integer
cbElements As Long
cLocks As Long
pvData As Long
Bounds(0 To 1) As SAFEARRAYBOUND
End Type
Private Declare Function VarPtrArray Lib "msvbvm50.dll" Alias "VarPtr" (Ptr() As Any) As Long

Private m_cDib As New cDibSection

Private Sub pLoad(ByVal sFIle As String)
Dim oPic As StdPicture
Set oPic = LoadPicture(sFIle)
m_cDib.CreateFromPicture oPic
picImage.Picture = oPic
lblSize.Caption = sFIle & " (" & m_cDib.Width & " x " & m_cDib.Height & ")"
End Sub

Private Sub cmdLoad_Click()
Dim cD As New GCommonDialog
Dim sFIle As String
If (cD.VBGetOpenFileName( _
Filename:=sFIle, _
Filter:="All Picture Files (*.BMP;*.JPG;*.GIF)|*.BMP;*.JPG;*.GIF|Bitmaps (*.BMP)|*.BMP|JPEGs (*.JPG)|*.JPG|GIFs (*.GIF)|*.GIF|All Files (*.*)|*.*", _
Owner:=Me.hwnd)) Then
pLoad sFIle
End If
End Sub

Private Sub cmdCount_Click()
Dim i As Long
Dim cGreen(0 To 255) As cIndexCollection2
For i = 0 To 255
Set cGreen(i) = New cIndexCollection2
cGreen(i).AllocationSize = 32
Next i

Dim tSA As SAFEARRAY2D
Dim bDib() As Byte
With tSA
.cbElements = 1
.cDims = 2
.Bounds(0).cElements = m_cDib.Height
.Bounds(0).lLbound = 0
.Bounds(1).cElements = m_cDib.BytesPerScanLine
.Bounds(1).lLbound = 0
.pvData = m_cDib.DIBSectionBitsPtr
End With

CopyMemory ByVal VarPtrArray(bDib()), VarPtr(tSA), 4

Dim x As Long, y As Long, xEnd As Long
Dim lC As Long, lGray As Long
Dim lInsertIndex As Long
xEnd = (m_cDib.Width - 1) * 3
For x = 0 To xEnd Step 3
For y = 0 To m_cDib.Height - 1
lC = bDib(x, y) + bDib(x + 2, y) * &H100&
If (cGreen(bDib(x + 1, y)).BinarySearch(lC, lInsertIndex) = 0) Then
cGreen(bDib(x + 1, y)).Add lC, lInsertIndex
End If
Next y
Next x

CopyMemory ByVal VarPtrArray(bDib()), 0&, 4

lC = 0
For i = 0 To 255
lC = lC + cGreen(i).Count
Next i
'MsgBox "The number of unique colours in this image is " & lC, vbInformation
Label3.Caption = lC
SSS1.Speak ("The number of unique colours in this image is " & lC)
End Sub

Private Sub Form_Load()
Dim sFIle As String
sFIle = App.Path
If (Right$(sFIle, 1) <> "") Then sFIle = sFIle & ""
sFIle = sFIle & "RED.jpg"
pLoad sFIle
End Sub

End Here…………………………

Used three modules

1. cDibsection.cls Author: Steve McMahon
2. cIndexcollection2.cls
3. GCommondialog.cls Author: Steve McMahon based on original by Bruce McKinney

For help email me: redu0007@yahoo.com

Conclusion
Form any image or object how many unique colors are present some time we need to know in our robotic project that will be use for color detection.