VBA获取像素颜色

Question

我正在将图像导入 Excel，并尝试计算图像的用户定义区域的平均颜色。为此，用户创建一个边界，然后循环遍历屏幕像素以查看它们是否落在该边界内 - 如果落在该边界内，则该像素的 RGB 会添加到集合中，然后在最后进行平均。

我基本上已经让这一切正常工作，但是由于某种原因我的代码像素颜色检测错误。应该是黄色或蓝色像素（或任何其他颜色）的像素被记录为灰色阴影（通常为 16777215 或 13948116，以 Windows 十进制值表示）。

我假设 PixelColor 函数有问题，该函数旨在获取我输入的 XY 坐标的像素颜色（例如 -1107 或 830 等值），但必须返回某些颜色其他像素。我尝试根据鼠标光标所在的像素检测颜色的代码进行调整，但在尝试为其提供 XY 坐标而不是从光标位置获取坐标时显然出现了问题。

获取像素颜色并转换为RGB的代码如下：

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

这些输入到循环单元格的代码中，该单元格使用 XY 坐标，例如 -1107 或 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

任何我出错的想法都会很棒......提前感谢您的帮助！

Answer 1

我想要说明的是该GetPixelAPI 适用于位图对象。在一张照片上。我不想说在工作表上有一张图片并尝试直接在屏幕上（而不是在位图对象上）使用它，该函数将无法正确返回。我只是觉得也许不是。前段时间，我曾经使用 VBA 以如下方式确定图片（未在 Excel 中加载）的某些像素颜色：

必要的 API 函数（在模块顶部的声明部分）：

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

完成这项工作的函数将是下一个：

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

测试过程应该如下所示：

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

我没有时间试验你的方法并理解为什么它没有返回你需要的东西。我只建议测试我的代码，如果它返回您需要的内容，找到一种使用 Image 对象的方法，即使加载而不是屏幕矩形......这只是一个建议！