![]() |
||||||
Colors counter project:
![]() 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. |
![]() |