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

我想要说明的是GetPixel API 适用于位图对象。在一张图片上。我不想说在工作表上有一张图片并尝试直接在屏幕上使用它（而不是在位图对象上）该函数将无法正确返回。我只是觉得它可能不是。 前段时间，我使用 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 对象的方法，即使加载而不是屏幕矩形...这只是一个建议！