VBA получить цвет пикселей

Question

Я импортирую изображения в Excel и пытаюсь рассчитать средний цвет для определенной пользователем области изображения. Чтобы сделать это, пользователь создает границу, а затем пропускает пиксели экрана oop, чтобы увидеть, попадают ли они в эту границу или нет - если они это делают, то 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

Я хотел бы отметить, что API GetPixel работает с растровым объектом. На картинке. Я не хочу говорить, что при наличии изображения на листе и попытке использовать его непосредственно на экране (а не на растровом объекте) функция не будет возвращаться правильно. Просто я думаю, что это не так. Некоторое время go я использовал для определения цвета некоторых пикселей для изображения (не загруженного в Excel) с помощью VBA следующим образом:

Необходимые функции 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

I не успеваешь поэкспериментировать со своим путем и понять, почему он не возвращает то, что тебе нужно. Я бы предложил только протестировать мой код и в случае, если он возвращает то, что вам нужно, чтобы найти способ использовать объект Image, даже если он загружен вместо прямоугольника экрана ... Это только предложение!