VBA获取像素颜色

Question

VBA获取像素颜色

excelvbagetpixel

5

我正在将图片导入到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

这些内容将被输入到循环遍历单元格的代码中，该代码使用诸如-1107或830之类的XY坐标：

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

如果您能提供任何想法，指出我的错误，那就太好了...非常感谢您的帮助！

- Nat Aes

你尝试获取屏幕上的像素颜色了吗？ - FaneDuru

我不确定你@FaneDuru的意思。使用XY坐标-1105，815运行此代码会输出颜色16777215（灰色）。实际上，我是从一个吸管工具中获取这些坐标的，该工具除了颜色（黄色）外还输出了坐标。 - Nat Aes

我的意思是GetPixelAPI可以检索位图对象的像素颜色。我知道它可以使用LoadPicture加载，然后需要使用CreateCompatibleDCAPI创建lDC...获取PixelColor后，必须使用DeleteDCAPI释放内存。我无法在此处发布所需的API和代码...如果有兴趣，我可以创建一个使用上述描述过程的函数。 - FaneDuru

如果您能做到，那将是太棒了！ - Nat Aes

1个回答

网页内容由stack overflow 提供, 点击上面的

可以查看英文原文，
原文链接

- FaneDuru · Accepted Answer

我想要指出的是，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对象的方法，即使是已加载的对象而不是屏幕矩形...这只是一个建议！