Solved

# counting a colors pixels on picturebox urgent!

Posted on 2005-05-05
434 Views
Hello, I am currently counting a specific colors number of pixels in an area of a picturebox, if the number is > 175 then I add it to the listbox, however it takes a very long time to count the pixels?? is there any way I can speed the it up? It takes be about 5-10 seconds to scan 1 picture this is very slow...any ideas??

This is my function:

Public Function CountPixels(color As Long, picBox As PictureBox) As Long

Dim x As Long, y As Long
Dim handle As Long, count As Long
Dim Hcolor As Long
' cache form's hDC property
handle = picBox.hdc

For y = 0 To Int(picBox.ScaleY(picBox.ScaleHeight, vbTwips, vbPixels) / 2)
For x = 0 To Int(picBox.ScaleX(picBox.ScaleWidth, vbTwips, vbPixels) / 2)
Hcolor = (GetPixel(handle, x, y))
If Hcolor = color Then
count = count + 1
End If
Next
Next

CountPixels = count
End Function

Thanks
0
Question by:nffvrxqgrcfqvvc

LVL 2

Expert Comment

Hi,

Do you have to count every pixel?
0

LVL 29

Author Comment

Yes I am trying to calculate a specific color and get the number of pixels for the color..the above code works fine in doing that but if the image is large it takes very long...anyways I dont' know if the above coordinates are correct however I am trying to get the number of pixels in the middle area....pherhaps if i could calculate just a square area in the middle portion of the picture that would be great. but i dont know how i would do that.
0

LVL 7

Expert Comment

I saw a very slight improvement (8-10ms faster) by doing this:

Public Function CountPixels(color As Long, picBox As PictureBox) As Long

Dim x As Long, y As Long
Dim handle As Long, count As Long
Dim Hcolor As Long
Dim Area_height As Long
Dim Area_width As Long
' cache form's hDC property
handle = picBox.hdc
Area_height = Int(picBox.ScaleY(picBox.ScaleHeight, vbTwips, vbPixels) / 2)
Area_width = Int(picBox.ScaleX(picBox.ScaleWidth, vbTwips, vbPixels) / 2)

For y = 0 To Area_height
For x = 0 To Area_width
If GetPixel(handle, x, y) = color Then
count = count + 1
End If
Next
Next

CountPixels = count
End Function

Overall, the average speed I get is 150ms for a 640x480 image (measured with GetTickCount).

0

LVL 7

Expert Comment

To get an area from the center section only, here's my whole project (has Picture1 as a picturebox and Command1 as a command button):

Private Declare Function GetTickCount Lib "kernel32" () As Long
Private Declare Function GetPixel Lib "gdi32" (ByVal hdc As Long, ByVal x As Long, ByVal y As Long) As Long

Private Const AreaWidth = 320  'pixels
Private Const AreaHeight = 240

Public Function CountPixels(color As Long, picBox As PictureBox) As Long

Dim x As Long, y As Long
Dim handle As Long, count As Long
Dim Hcolor As Long
Dim X_LocationA As Long
Dim X_LocationB As Long
Dim Y_LocationA As Long
Dim Y_LocationB As Long

' cache form's hDC property
handle = picBox.hdc

X_LocationA = (picBox.ScaleX(picBox.ScaleWidth, vbTwips, vbPixels) / 2) - (AreaWidth / 2)
X_LocationB = (picBox.ScaleX(picBox.ScaleWidth, vbTwips, vbPixels) / 2) + (AreaWidth / 2)
Y_LocationA = (picBox.ScaleX(picBox.ScaleHeight, vbTwips, vbPixels) / 2) - (AreaHeight / 2)
Y_LocationB = (picBox.ScaleX(picBox.ScaleHeight, vbTwips, vbPixels) / 2) + (AreaHeight / 2)

For y = Y_LocationA To Y_LocationB
For x = X_LocationA To X_LocationB
If GetPixel(handle, x, y) = color Then
count = count + 1
End If
Next
Next

CountPixels = count
End Function

Private Sub Command1_Click()
Dim lngTime As Long
Dim lngCount As Long
lngTime = GetTickCount()
lngCount = CountPixels(vbWhite, Picture1)
Me.Caption = lngCount & " pixels -- " & GetTickCount - lngTime & "ms"
End Sub

You can adjust the size of the center area by changing the two constants at the top.
0

LVL 7

Expert Comment

Remember to compile the project to get faster speeds. Running it in the development environment (i.e. "play button") will result in it going slower.
0

LVL 29

Author Comment

Ic..is there anyway I can draw a line on the picture to show me where its looking for the pixels at??

picture1.line()??

I don't deal much with graphics sorry for my lack of knowledge in this area, that seems to work alot better but I just want to be able to see where its searching the pixels
0

LVL 7

Accepted Solution

Add this (it's kind of sloppy-looking but it gets the job done):

picBox.Line (15 * X_LocationA, 15 * Y_LocationA)-(15 * X_LocationB, 15 * Y_LocationA), vbBlack
picBox.Line (15 * X_LocationA, 15 * Y_LocationB)-(15 * X_LocationB, 15 * Y_LocationB), vbBlack
picBox.Line (15 * X_LocationA, 15 * Y_LocationA)-(15 * X_LocationA, 15 * Y_LocationB), vbBlack
picBox.Line (15 * X_LocationB, 15 * Y_LocationA)-(15 * X_LocationB, 15 * Y_LocationB), vbBlack

So the entire thing would be:

Private Declare Function GetTickCount Lib "kernel32" () As Long
Private Declare Function GetPixel Lib "gdi32" (ByVal hdc As Long, ByVal x As Long, ByVal y As Long) As Long

Private Const AreaWidth = 320  'pixels
Private Const AreaHeight = 240

Public Function CountPixels(color As Long, picBox As PictureBox) As Long

Dim x As Long, y As Long
Dim handle As Long, count As Long
Dim Hcolor As Long
Dim X_LocationA As Long
Dim X_LocationB As Long
Dim Y_LocationA As Long
Dim Y_LocationB As Long

' cache form's hDC property
handle = picBox.hdc

X_LocationA = (picBox.ScaleX(picBox.ScaleWidth, vbTwips, vbPixels) / 2) - (AreaWidth / 2)
X_LocationB = (picBox.ScaleX(picBox.ScaleWidth, vbTwips, vbPixels) / 2) + (AreaWidth / 2)
Y_LocationA = (picBox.ScaleX(picBox.ScaleHeight, vbTwips, vbPixels) / 2) - (AreaHeight / 2)
Y_LocationB = (picBox.ScaleX(picBox.ScaleHeight, vbTwips, vbPixels) / 2) + (AreaHeight / 2)

picBox.Line (15 * X_LocationA, 15 * Y_LocationA)-(15 * X_LocationB, 15 * Y_LocationA), vbBlack
picBox.Line (15 * X_LocationA, 15 * Y_LocationB)-(15 * X_LocationB, 15 * Y_LocationB), vbBlack
picBox.Line (15 * X_LocationA, 15 * Y_LocationA)-(15 * X_LocationA, 15 * Y_LocationB), vbBlack
picBox.Line (15 * X_LocationB, 15 * Y_LocationA)-(15 * X_LocationB, 15 * Y_LocationB), vbBlack

For y = Y_LocationA To Y_LocationB
For x = X_LocationA To X_LocationB
If GetPixel(handle, x, y) = color Then
count = count + 1
End If
Next
Next

CountPixels = count
End Function

Private Sub Command1_Click()
Dim lngTime As Long
Dim lngCount As Long
lngTime = GetTickCount()
lngCount = CountPixels(vbWhite, Picture1)
Me.Caption = lngCount & " pixels -- " & GetTickCount - lngTime & "ms"
End Sub
0

## Featured Post

### Suggested Solutions

Have you ever wanted to restrict the users input in a textbox to numbers, and while doing that make sure that they can't 'cheat' by pasting in non-numeric text? Of course you can do that with code you write yourself but it's tedious and error-prone …
Since upgrading to Office 2013 or higher installing the Smart Indenter addin will fail. This article will explain how to install it so it will work regardless of the Office version installed.
Show developers how to use a criteria form to limit the data that appears on an Access report. It is a common requirement that users can specify the criteria for a report at runtime. The easiest way to accomplish this is using a criteria form that a…
This lesson covers basic error handling code in Microsoft Excel using VBA. This is the first lesson in a 3-part series that uses code to loop through an Excel spreadsheet in VBA and then fix errors, taking advantage of error handling code. This l…