VBA Get Colour of Pixel

Question

I'm importing images into Excel, and trying to calculate the average colour for a user-defined area of the image. To do that, the user creates a boundary and then I loop through the screen pixels to see whether or not they fall within this boundary - if they do, then the RGB of that pixel is added to a collection before averaging out at the end.

I've broadly got this all working, however for some reason my code is getting the pixel colour detection wrong. What should be yellow or blue pixels (or any other colour) instead gets recorded as a shade of grey (more often than not 16777215 or 13948116, in Windows decimal value).

I assume that I've got something wrong with the PixelColor function, which is intended to get the pixel colour for the XY co-ordinates I feed into it (values such as -1107 or 830) but instead must be returning the colour of some other pixels. I tried to adapt this from code that detects colour based on the pixel the mouse cursor is at, but clearly got something wrong in trying to feed it XY co-ordinates rather than get this from the cursor position.

The code to get the pixel colour and also convert to RGB is as follows:

Private Declare PtrSafe Function GetPixel Lib "gdi32" (ByVal hdc As Long, ByVal X As Long, ByVal Y As Long) As Long
Private Declare PtrSafe Function GetCursorPos Lib "user32" (ByRef lpPoint As POINT) As LongPtr
Private Declare PtrSafe Function GetWindowDC Lib "user32" (ByVal hwnd As LongPtr) As LongPtr
Private Declare PtrSafe Function GetDC Lib "user32" (ByVal hwnd As Long) As Long
Private Type POINT
    X As Long
    Y As Long
End Type

Private Function PixelColor(ByVal X As Long, ByVal Y As Long) As Long

Dim lDC As Variant

lDC = GetWindowDC(0)
PixelColor = GetPixel(lDC, X, Y)

End Function

These feed into the code that loops through the cells, which uses XY co-ordinates such as -1107 or 830:

Sub AverageColour()

'loop through pixels
For i = MinX To MaxX
    For j = MinY To MaxY
        'check if pixel falls within user-defined polygon
        If udfPointInPolygon(i, j, Range("B2:C21")) = True Then
            PointColor = PixelColor(i, j)
            collR.Add CStr(m_RGB_Red(PointColor))
            collG.Add CStr(m_RGB_Green(PointColor))
            collB.Add CStr(m_RGB_Blue(PointColor))
        End If
    Next j
Next i

'calculate collection averages
totalR = 0
totalG = 0
totalB = 0

For k = 1 To collR.Count
    totalR = totalR + collR(k)
Next k

For k = 1 To collG.Count
    totalG = totalG + collG(k)
Next k

For k = 1 To collB.Count
    totalB = totalB + collB(k)
Next k

averageR = totalR / collR.Count
averageG = totalG / collG.Count
averageB = totalB / collB.Count

End Sub

Any ideas where I've gone wrong would be great...thanks in advance for your help!

Answer 1

What I wanted o remark is the GetPixel API works on a bitmap object. On a picture. I do not want saying that having a picture on the sheet and trying to use it directly on the screen (not on a bitmap object) the function will not return correctly. I just think that it maybe not. Some time ago, I used to determine some pixels color for a picture (not loaded in Excel) using VBA in the next way:

The necessary API functions (on top of the module, in the declarations part):

Private Declare PtrSafe Function SelectObject Lib "gdi32" (ByVal hdc As Long, ByVal hObject As Long) As Long
Private Declare PtrSafe Function CreateCompatibleDC Lib "gdi32" (ByVal hdc As Long) As Long
Private Declare PtrSafe Function DeleteDC Lib "gdi32" (ByVal hdc As Long) As Long
Private Declare PtrSafe Function GetPixel Lib "gdi32" (ByVal hdc As Long, ByVal X As Long, ByVal Y As Long) As Long

The function doing the job would be the next:

Private Function PixelColorBis(objPict As Object, ByVal X As Long, ByVal Y As Long) As Long
 Dim lDC As Variant
  
 lDC = CreateCompatibleDC(0)
 SelectObject lDC, objPict.Handle
 PixelColorBis = GetPixel(lDC, X, Y)

 DeleteDC lDC
End Function

And a test procedure should look like this:

Sub testPixelColor()
  Dim objPict As Object, pictPath As String, objImage As Object
  
  pictPath = ThisWorkbook.path & "\Poza Carte Munca.jpg" ' use here your picture path
  'Obtain the picture dimensions in pixels______________________________________________________
  Set objImage = CreateObject("WIA.ImageFile")
  objImage.LoadFile ThisWorkbook.path & "\Poza Carte Munca.jpg"
  Debug.Print objImage.width, objImage.height ' picture dimensions in pixels
  'using the above dimensions you can iterate between the width pixels number and the heigh, too.
  '_____________________________________________________________________________________________
  
  Set objPict = LoadPicture(pictPath) 'the picture object to be processed 
  
  Debug.Print PixelColorBis(objPict, 2, 3) 'I just used sample X and Y only to check the function functionality
End Sub

I do not have time to experiment your way and understand why it does not return what you need. I would only suggest to test my code and in case it returns what you need, to find a way to use Image object, even if loaded instead of screen rectangle... This is only a suggestion!