使用 GetDIBits() 获取像素 RGB 颜色值

Question

我想使用 GetDIBits() 获取像素 RGB 颜色值。我已经可以使用 GetPixel() 获得像素 RGB 颜色值，但效率不高。我听说 GetDIBits() 在这方面做得更好。

运行时没有错误，但像素点的RGB值一直是0。你能指出什么是错的吗？我不熟悉 Windows API.

这是我的代码：

Private Declare Function CreateCompatibleDC Lib "gdi32" (ByVal hdc As Long) As Long
Private Declare Function CreateCompatibleBitmap Lib "gdi32" (ByVal hdc As Long, ByVal nWidth As Long, ByVal nHeight As Long) As Long
Private Declare Function SelectObject Lib "gdi32" (ByVal hdc As Long, ByVal hObject As Long) As Long
Private Declare Function GetDC Lib "user32" (ByVal hWnd As Long) As Long
Private Declare Function BitBlt Lib "gdi32" (ByVal hdc As Long, ByVal x As Long, ByVal y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hSrcDC As Long, ByVal xSrc As Long, ByVal ySrc As Long, ByVal opCode As Long) As Long
Private Declare Function ReleaseDC Lib "user32" (ByVal hWnd As Long, ByVal hdc As Long) As Long
Private Declare Function GetDeviceCaps Lib "gdi32" (ByVal hdc As Long, ByVal nIndex As Long) As Long
Private Declare Function DeleteDC Lib "gdi32" (ByVal hdc As Long) As Long
Private Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long
Private Declare Function GetDIBits Lib "gdi32" (ByVal hdc As Long, ByVal hBitmap As Long, ByVal nStartScan As Long, ByVal nNumScans As Long, lpBits As Any, lpBI As BITMAPINFO, ByVal wUsage As Long) As Long

Const HORZRES As Integer = 8
Const VERTRES As Integer = 10

Private Type BITMAPINFOHEADER
  biSize As Long
  biWidth As Long
  biHeight As Long
  biPlanes As Integer
  biBitCount As Integer
  biCompression As Long
  biSizeImage As Long
  biXPelsPerMeter As Double
  biClrUsed As Double
End Type
Private Type RGBQUAD
    rgbBlue As Byte
    rgbGreen As Byte
    rgbRed As Byte
    rgbReserved As Byte
End Type
Private Type BITMAPINFO
  bmiHeader As BITMAPINFOHEADER
  bmiColors As RGBQUAD
End Type

Private Sub Form_Load()
    
    Dim hdc As Long
    Dim hDcmem As Long
    Dim hBmp As Long
    Dim oldBmp As Long
    Dim bmi As BITMAPINFO
    
    Dim OriginalImage() As Long
    
    Dim width As Long
    Dim height As Long
    
    Dim pixel As Long
    Dim r As Integer
    Dim b As Integer
    Dim g As Integer
   
    hdc = GetDC(0)
    hDcmem = CreateCompatibleDC(0)
    hBmp = CreateCompatibleBitmap(hdc, width, height)
    oldBmp = SelectObject(hDcmem, hBmp)

    width = GetDeviceCaps(hdc, HORZRES)
    height = GetDeviceCaps(hdc, VERTRES)
    
    ReDim OriginalImage(width - 1, height - 1)

    With bmi.bmiHeader
        .biBitCount = 32
        .biCompression = BI_RGB
        .biPlanes = 1
        .biWidth = width
        .biHeight = height
        .biSize = Len(bmi.bmiHeader)
    End With

    BitBlt hDcmem, 0, 0, width, height, hdc, 0, 0, vbSrcCopy
    GetDIBits hDcmem, hBmp, 0, height, OriginalImage(0, 0), bmi, DIB_RGB_COLORS

    pixel = OriginalImage(565, 1022) '<-the x, y coordinate of pixel requested
    r = pixel Mod 256
    g = ((pixel And &HFF00) / 256&) Mod 256&
    b = (pixel And &HFF0000) / 65536

    Debug.Print "Color is - r: " & r & " g: " & g & " b: " & b

    SelectObject hDcmem, oldBmp
    DeleteObject hBmp
    DeleteDC hDcmem
    ReleaseDC 0, hdc
    
End Sub

此代码基于 this answer。

Answer 1

您在设置高度和宽度之前调用了 CreateCompatibleBitmap 函数。你的高度和宽度是 0 ，所以你的 hbmp 永远不会包含数据。

const BI_RGB 和 Const DIB_RGB_COLORS 未声明

您忽略了 32 位颜色的 alpha 通道，最好使用字节数组来捕获单个 R G B 颜色

尝试下面显示的编辑代码

Option Explicit

Private Declare Function CreateCompatibleDC Lib "gdi32" (ByVal hdc As Long) As Long
Private Declare Function CreateCompatibleBitmap Lib "gdi32" (ByVal hdc As Long, ByVal nWidth As Long, ByVal nHeight As Long) As Long
Private Declare Function SelectObject Lib "gdi32" (ByVal hdc As Long, ByVal hObject As Long) As Long
Private Declare Function GetDC Lib "user32" (ByVal hWnd As Long) As Long
Private Declare Function BitBlt Lib "gdi32" (ByVal hdc As Long, ByVal x As Long, ByVal y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hSrcDC As Long, ByVal xSrc As Long, ByVal ySrc As Long, ByVal opCode As Long) As Long
Private Declare Function ReleaseDC Lib "user32" (ByVal hWnd As Long, ByVal hdc As Long) As Long
Private Declare Function GetDeviceCaps Lib "gdi32" (ByVal hdc As Long, ByVal nIndex As Long) As Long
Private Declare Function DeleteDC Lib "gdi32" (ByVal hdc As Long) As Long
Private Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long
Private Declare Function GetDIBits Lib "gdi32" (ByVal hdc As Long, ByVal hBitmap As Long, ByVal nStartScan As Long, ByVal nNumScans As Long, lpBits As Any, lpBI As BITMAPINFO, ByVal wUsage As Long) As Long

Const HORZRES As Integer = 8
Const VERTRES As Integer = 10

Private Type BITMAPINFOHEADER
  biSize As Long
  biWidth As Long
  biHeight As Long
  biPlanes As Integer
  biBitCount As Integer
  biCompression As Long
  biSizeImage As Long
  biXPelsPerMeter As Double
  biClrUsed As Double
End Type
Private Type RGBQUAD
    rgbBlue As Byte
    rgbGreen As Byte
    rgbRed As Byte
    rgbReserved As Byte
End Type
Private Type BITMAPINFO
  bmiHeader As BITMAPINFOHEADER
  bmiColors As RGBQUAD
End Type

Private Const BI_RGB = 0&
Private Const DIB_RGB_COLORS = 0

Private Sub Form_Load()
    
    Dim hdc As Long
    Dim hDcmem As Long
    Dim hBmp As Long
    Dim oldBmp As Long
    Dim bmi As BITMAPINFO
    
    Dim OriginalImage() As Byte
    
    Dim width As Long
    Dim height As Long
    
    
    Dim r As Byte
    Dim b As Byte
    Dim g As Byte
    Dim a As Byte
   
    hdc = GetDC(0)
    hDcmem = CreateCompatibleDC(0)

    width = GetDeviceCaps(hdc, HORZRES)
    height = GetDeviceCaps(hdc, VERTRES)
    
    ReDim OriginalImage(1 To 4, width - 1, height - 1)
    hBmp = CreateCompatibleBitmap(hdc, width, height)
    oldBmp = SelectObject(hDcmem, hBmp)

    With bmi.bmiHeader
        .biBitCount = 32
        .biCompression = BI_RGB
        .biPlanes = 1
        .biWidth = width
        ' Use negative height to scan top-down.
        .biHeight = -height
        .biSize = Len(bmi.bmiHeader)
    End With

    BitBlt hDcmem, 0, 0, width, height, hdc, 0, 0, vbSrcCopy
    GetDIBits hDcmem, hBmp, 0, height, OriginalImage(1, 0, 0), bmi, DIB_RGB_COLORS
    
    r = OriginalImage(1, 565, 1022)
    g = OriginalImage(2, 565, 1022)
    b = OriginalImage(3, 565, 1022)
    a = OriginalImage(4, 565, 1022)
    
    Debug.Print "Color is - r: " & r & " g: " & g & " b: " & b

    SelectObject hDcmem, oldBmp
    DeleteObject hBmp
    DeleteDC hDcmem
    ReleaseDC 0, hdc
    
End Sub

使用 GetDIBits() 获取像素 RGB 颜色值

Get pixel RGB color values using GetDIBits()

vb6

winapi