scan picture for specific hex color values? urgent

As a starting point i can check for 1 hex value like this...

If Hex(Picture1.Point(x, y)) = Hex(&HC6D7FF) Then
MsgBox "found"
Else
Debug.Print "not found:"
End If

But i want to put all the possible hex values to check in a text file then i supose load those hex values into and array and scan the image for the most percentage of the certain hex value that is found.

edit: step 3 should avoid calling the Point method inside the colour loop, it should be:

Dim lRow as Long           'Step 3 - Count the number of occurences in the picture
Dim lCol as Long
Dim lColour as Long
Dim lPixelColour as Long
  With Picture1
    For lRow = 0 to .Picture.Height   '(these two lines may not be quite right - I cant test on this PC)
      For lCol = 0 to .Picture.Width    '
        lPixelColour = .Point(lCol, lRow)
        For lColour = 0 To lColourCount
           If lPixelColour = aColour(lColour) Then
             aCount(lColour) = aCount(lColour) + 1
             Exit For  '(move on to next pixel)
           End If
        Next lColour
      Next lCol
    Next lRow
  End With    '(aCount now contains the number of times that each coulour is in the picture)

I get sub or function not defined on the following line:

 If lPixelColour = acolour(lColour) Then

Oops..  minor typo there (and in step 4), I missed the S in aColours

Yes I i did change all that but i still am getting errors

After changing it to aColours i get an error on the following line::

  aColours(lIndex) = CLng(aColours(lIndex))   '(you could use the Hex function here, but CLng is faster)

TYPE MISMATCH

The type mismatch is this exact line:      CLng(aColours(lIndex))

however acolours = "HEX COLOR" and lIndex=0 and CLng(aColours(lIndex))=type mismatch
when i move the cursor over the debuger it displays this

it should be able to convert a hex string.. (it works in the VBA editor of Excel)

have you got the text "HEX COLOR" in your file?  if so, you should remove it, and only have the Hex values in your file.
(or do you mean aColours(lIndex) contains something like "&HC6D7FF" ?  in this case it should be fine)


An alternative for that line:
aColours(lIndex) = Val(aColours(lIndex))

I dont actually have the &H i just have thisis the text file

7B96C6
8496C6
7B92BD
6B8AC6
6379B5
637DB5
5271AD
4A6DA5
42699C
426594
396194
314563
294D73


Should I replce all of them with &H00 at the beggining?

I got it to scan but it freezes VB and it makes the IDE not respond I need to CTRL ALT DELETE

You need the &H (it isn't a Hex number without it), unless you change the code to:

aColours(lIndex) = CLng("&H" & aColours(lIndex))


To stop the "freeze", add a DoEvents like this (in step 3):

       Next lColour
       DoEvents
      Next lCol
      '(or here instead)
    Next lRow

This will slow things down a bit, but your program will respond more quickly.

Aright..basically I will give you these points anyway, but my goal was to check a picture to see if a certain image if the person was either wearing clothing or if they are not wearin clothing..At first I was just going to store the hex values in a text file and check for the hex value itself(these were skin tone like hex values) but then I found out that almost every picture is different and has different hex values...( so that route didn't work)

But I have another IDEA:

Now i changed it so that I am looking at the middle of the image and checking for RGB values like if there is red blue or green in the middle than the person is either wearing a red,blue or green shirt...some images vary depending on the positioning of the person in the image thats wearing the shirt...I can get it to work to a certain extent using this code but if the hex value isnt an absolute value of RED GREEN or BLUE it won't detect it..

This is how I managed to go about it..

If you know the answere I will start a new thread and give you 500 more points:



Private Declare Function GetNearestColor Lib "gdi32" _
(ByVal hdc As Long, ByVal crColor As Long) As Long
Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)



Private Sub Form_Load()
Form1.Visible = True
Form1.Show
Picture1.AutoRedraw = True
   Picture1.Picture = LoadPicture("C:\pa7.bmp")
     Picture1.PaintPicture Picture1.Picture, 0, 0, Picture1.ScaleWidth, Picture1.ScaleHeight


   
    Caption = Hex(Picture1.Point(Picture1.Width / 2, Picture1.Height / 2))
    Label1.BackColor = "&H" & Caption
    On Error Resume Next
   
    Label1.BackColor = GetNearestColor(Picture1.hdc, Caption)


For i = 1 To 255
If Picture1.Point(Picture1.Width / 2, Picture1.Height / 2) = RGB(0, i, 0) Then
MsgBox "WEARING A GREEN SHIRT"

Else

If Picture1.Point(Picture1.Width / 2, Picture1.Height / 2) = RGB(i, 0, 0) Then
MsgBox "WEARING A RED SHIRT"

Else

If Picture1.Point(Picture1.Width / 2, Picture1.Height / 2) = RGB(0, 0, i) Then
MsgBox "WEARING A BLUE SHIRT"

Else

If Picture1.Point(Picture1.Width / 2, Picture1.Height / 2) = vbBlack Then
MsgBox "WEARING A WHITE SHIRT"


End If
End If
End If
End If

Next i
End Sub

Ah... checking for skin is rather complex to say the least!!

The company I work for was part of a trial for a big project like that, being done by a major email scanning firm; even after months of many people developing it (probably dozens of them) it was still producing more false positives than valid positives - it was stopping company logos coming though, but not stopping several unwanted photos.

You need to take into account that there are many skin colours (just think of how many hundreds of shades of "white" there are, even without skin blemishes and tattoos etc.), and that clothing can be a colour which is very similar to a skin colour (not necesarilly the same as the person wearing it though), and that you will almost certainly have a background too - which could contain sections that are almost "skin" coloured too.

No matter how you try to work it out, the best you can manage to work out is if there are patches of a particular colour (in various similar shades).  Your idea of converting the colour down to RGB is good, but doesn't offer enough reduction for this kind of work (there are still 16 million colours!).

What you need to do really is check each pixel against each of it's neighbours, and see how much change there is in each of R, G, and B - if the change is big enough then treat it as a different colour (not like the method below!).  With a lot more theory work you could detemine how big the patches of the "same" colour are, and apply some sort of rule.


For what you are currently trying though..
To extract the RGB portion of your pixel colour you could use this:

Dim lRed as Long, lGreen as Long, lBlue as Long
  lRed = Picture1.Point(Picture1.Width / 2, Picture1.Height / 2) Mod 256
  lGreen = (Picture1.Point(Picture1.Width / 2, Picture1.Height / 2) \ 256) Mod 256
  lBlue = (Picture1.Point(Picture1.Width / 2, Picture1.Height / 2) \ 256) \ 256

Then you can take a fraction of the values to work out vaguely what colour you have, eg:
  lRed = lRed \ 25.6   '(convert to 0-10)
  lGreen = lGreen \ 25.6
  lBlue = lBlue \ 25.6

  Select Case lRed
  Case > 7   '(lots of red)

    Select Case lGreen
    Case > 7   '(lots of green)
      Select Case lBlue
      Case > 7:    MsgBox "white"
      Case > 3:    MsgBox "light yellow"
      Case Else:   MsgBox "dark yellow"
      End Select
    Case > 3   '(medium green)
      Select Case lBlue
      Case > 7:    MsgBox "pink"
      Case > 3:    MsgBox "light orange"
      Case Else:   MsgBox "orange"
      End Select
    Case Else  '(some/no green)
      Select Case lBlue
      Case > 7:    MsgBox "??"
      Case > 3:    MsgBox "??"
      Case Else:   MsgBox "??"
      End Select
    End Select

  Case > 3   '(medium red)
    '(repeat entire "lGreen" section here, but with different colours)

  Case Else  '(some/no red)
    '(repeat entire "lGreen" section here, but with different colours)

  End Select

Thank you for your comments...

'Check this out....

This is what I am in the process of doing..This sub will flash all pixels that it finds on the image when specifying a specific hex value..


Private Sub FlashColors(PicBox As PictureBox, Pic As String, _
                        ColorToFlashFrom As OLE_COLOR, _
                        ColorToFlashTo As OLE_COLOR, _
                        NoFlashes As Long)
                       
    Dim Black() As Boolean
    Dim PresentColor As OLE_COLOR
    Dim x As Long
    Dim y As Long
    Dim i As Integer
    Dim ii As Integer
    Dim xx As Long
    Dim yy As Long
   
    PicBox.AutoRedraw = True
    PicBox.Picture = LoadPicture(Pic)
    PicBox.PaintPicture PicBox.Picture, 0, 0, PicBox.ScaleWidth, PicBox.ScaleHeight
   
    ReDim Black(PicBox.ScaleWidth / 15, PicBox.ScaleHeight / 15) As Boolean
   
    For x = 0 To PicBox.ScaleWidth / 15
        For y = 0 To PicBox.ScaleHeight / 15
            If PicBox.Point(x * 15, y * 15) = ColorToFlashFrom Then
                Black(x, y) = True
               
            Else
                Black(x, y) = False
            End If
        Next y
        y = 0
    Next x
     
    PresentColor = ColorToFlashTo
    PicBox.AutoRedraw = True
   
    For i = 1 To NoFlashes
    For ii = 1 To 2
        DoEvents
        PicBox.ForeColor = PresentColor
       
               
         
        For xx = 0 To PicBox.ScaleWidth / 15
            For yy = 0 To PicBox.ScaleHeight / 15
                If Black(xx, yy) = True Then
               
                    PicBox.Line (xx * 15, yy * 15)-((xx + 1) * 15, (yy + 1) * 15)
                End If
            Next yy
            yy = 0
        Next xx
       
        If PresentColor = ColorToFlashTo Then
            PresentColor = ColorToFlashFrom
        ElseIf PresentColor = ColorToFlashFrom Then
            PresentColor = ColorToFlashTo
        End If
       
       
    Next ii
    Next i


End Sub


FlashColors Picture1, "C:\pa5.bmp", &HFFFFFF, &H0&, 3






So basically what this will do is flash all the white pixels in a picture to black...which is I believe a start at this...White is not considered a skin color however I can scan an image for multiple skin tone hex values and if it detects a high majority of these pixels than you can assume than the image doesnt contain clothing...i am having trouble with this however I am not sure what would be a considerable integer to compare it..like say I have a list of all pigment hex value's from a light pinkish to a dark pinkish to a light brown to a darker brown the combination of hex values could be in the thousands...so is there some basic sequence to hex values in a sence that if a light brownish pigment color hex value is = 84A6D6 ..is there a sequence to getting the next darger hex value ? possibly like 84A6D7 84A6D8 84A6D9...etc..if there is a hex sequence that it follows I could check for all possible sequences of a pigment hex value..and loop it..the reason i would poing to the middle of the image is because..if i could bitblt the pictures background in some manner then get the mid section of the body if it doesnt return and red,green,blue value then you can condider that there isn't any clothing there..something to that extent..

Try that above code and if your willing to maybe give me some insight or a possible way that might be able to check for clothing on an image..i think the above code is a start..but I need expert opinion.. thanks..

A Hex colour is basically a nice representation of a Long colour, as each pair of digits is the equivalent to RGB, eg:

&HEF34BC is the same as:
 Blue = EF (hex) =  239 of 255 (decimal)
 Green = 34 (hex) =  52 of 255 (decimal)
 Red = BC (hex) =  188 of 255 (decimal)

The first piece of code in my previous post does this conversion (from a Hex or Long value).

For comparisons, you can start from a base number (say &H223344), and loop through all possible combinations up to your target value (say &H334455).
You would need to loop through all values for all 3 sections (R,G,B) of the number, which would take a long time (in this example nearly 5000 checks per pixel). My previous post did essentially the same thing, but with only 1 check per pixel ;-)  

You just need to change the second half of my previous post so that appropriate values are checked, eg: for the check of &H223344 to &H334455 you could use this inside your "For y" loop:

        Black(x, y) = False
Dim lPointColour as Long  '(using an extra variable to reduce calls to the .Point method)
Dim lRed as Long, lGreen as Long, lBlue as Long
        lPointColour = PicBox.Point(x * 15, y * 15)
        lRed = lPointColour Mod 256
        lGreen = (lPointColour \ 256) Mod 256
        lBlue = (lPointColour \ 256) \ 256

        If (lRed >= &H22) and (lRed <= &H33) Then
          If (lGreen >= &H33) and (lGreen <= &H44) Then
            If (lBlue >= &H44) and (lBlue <= &H55) Then
              Black(x, y) = True
            End If
          End If
        End If

This does of course mean that you will change the colour when the flash comes back to the original colour, so rather than use your Black array, I would recommend using an array of a Type (which contains the pixels X, Y, and Colour), and loop through this array for your flashing.

The hard task is to find the appropriate range of values.