GetDIBits失败了。它仅为像素返回零值

时间:2016-09-16 16:27:30

标签: vba hbitmap

我一直在寻找GetDIBits,似乎只能在Excel 2016以外的其他所有应用程序中找到讨论。

对于所有像素值,我一直回到0。我不知道使用Image1.Picture.Handle是否是hdc的正确陈述,我不知道Image1.Picture是否是hbitmap的正确陈述。

我甚至无法使用SetDIBits函数将结果显示在图像框中。

网络上的大多数内容都使用PictureBox和Autodraw,以及似乎不在Excel中的内容。

任何人都可以帮我解决这个问题。这将不胜感激。我会发布所有的声明,但我不想被启动网站,我的问题太长了。提前谢谢。

Private Sub CommandButton2_Click() 'Userform command button
Dim X As Long 'X coordinates for the pixels
Dim Y As Long 'Y coordinates for the pixels
Dim sw As BITMAP
Dim bmapinfo As BITMAPINFO 'Information about the bitmap
Dim xtPixels() As RGBPixel 'Array to place pixel data into
Dim oPic As IPictureDisp 'Declaration of picture used in this program
Set oPic = Image1.Picture 'making the picture an object
'All of the data below gives information about the picture
bmapinfo.bmiHeader.biSize = 40
bmapinfo.bmiHeader.biWidth = oPic.Width
bmapinfo.bmiHeader.biHeight = oPic.Height
bmapinfo.bmiHeader.biPlanes = 1
bmapinfo.bmiHeader.biBitCount = 24
'bmapinfo.bmiHeader.biCompression = BI_RGB
bmapinfo.bmiHeader.biXPelsPerMeter = ((((bmapinfo.bmiHeader.biWidth * bmapinfo.bmiHeader.biBitCount) + _
            31) \ 32) * 4)
        bmapinfo.bmiHeader.biYPelsPerMeter = bmapinfo.bmiHeader.biXPelsPerMeter - (((bmapinfo.bmiHeader.biWidth _
            * bmapinfo.bmiHeader.biBitCount) + 7) \ 8)
        bmapinfo.bmiHeader.biSizeImage = bmapinfo.bmiHeader.biXPelsPerMeter * Abs(bmapinfo.bmiHeader.biHeight)
  '  GetObjectAPI voPicture.Handle, LenB(tBmp), tBmp
  '  nBitCount = tBmp.bmWidth * tBmp.bmBitsPixel * tBmp.bmHeight \ 4
    ReDim xtPixels(1 To bmapinfo.bmiHeader.biWidth, 1 To bmapinfo.bmiHeader.biHeight)
'All of the data above gives information about the picture
        GetDIBits Image1.Picture.Handle, sw.bmBitsPixel, _
0, bmapinfo.bmiHeader.biHeight, xtPixels(1, 1), bmapinfo, _
DIB_RGB_COLORS


For Y = 1 To UBound(xtPixels, 1) - 1
    For X = 1 To UBound(xtPixels, 2) - 1
        'With xtPixels(Y, X)
        xtPixels(Y, X).Blue = xtPixels(Y, X).Blue
        xtPixels(Y, X).Green = xtPixels(Y, X).Green
        xtPixels(Y, X).Red = xtPixels(Y, X).Red
    Next X, Y
SetDIBits oPic.Handle, oPic.Handle, _
        0, bmapinfo.bmiHeader.biHeight, xtPixels(1, 1), _
        bmapinfo, DIB_RGB_COLORS
    'Set Image2.Picture = oPic.Render

End Sub

0 个答案:

没有答案