Read Bitmap into a 2D array ?

[JAAFAR]

Hi,

Is there out there some GDI or GDIPLUS function(s) or some other way to read fast the pixels of a bitmap into a 2D array But, without looping through each pixel ?

Thanks.

[The trick]

GetDiBits

[JAAFAR]

GetDiBits

Thanks,

I thought the lpvBits argument would store each pixel's RGB value in a 3D array: ie= each color in a single dimension of the array.

So, is this how you would call GetDiBits for storing the pixels in a 2D array?

 GetDIBits hdc, Picture.Handle, 0, Height, BITS(0, 0), BMI, 0

[xiaoyao]

get picture from picture1,change black to white, edit color byte() array,show it on picture2

[The trick]

Thanks,

I thought the lpvBits argument would store each pixel's RGB value in a 3D array: ie= each color in a single dimension of the array.

So, is this how you would call GetDiBits for storing the pixels in a 2D array?

 GetDIBits hdc, Picture.Handle, 0, Height, BITS(0, 0), BMI, 0

Both a 3d array and a 2D aray (and any array) of a scalar type is just the block of contiguous memory.

[JAAFAR]

Both a 3d array and a 2D aray (and any array) of a scalar type is just the block of contiguous memory.

Ok, I see - I will try that and post back later on.

Thanks.

[wqweto]

GetDIBits and SetDIBits actually *copy* DIB pixel data from/to the system DIB pixel buffer into a separate user-provided "offline" buffer.

When you call CreateDIBSection the system allocates an "array" of memory for the pixel data and returns a pointer to it in lpvBits output parameter. You can use this pointer to access the "online" buffer of the DIB, i.e. when you modify a pixel it's immediately reflected in the DIB and you can see the change when you paint the DIB. With "offline" buffer from GetDIBits you have to first modify the pixel, then upload the changes with SetDIBits which is slow and not something you want to do in a loop. So the best way to read and *modify* the pixels of a DIB is to use the pointer to the "online" buffer of pixel data.

Here is a function which can retrieve the original pointer as returned by CreateDIBSection when you only have the handle to the DIB from an StdPicture or similar.

Option Explicit

Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (lpDst As Any, lpSrc As Any, ByVal ByteLength As Long)
Private Declare Function ApiGetObject Lib "gdi32" Alias "GetObjectA" (ByVal hObject As Long, ByVal nCount As Long, lpObject As Any) As Long

Public Function GetDIBPointer(ByVal hDib As Long) As Long
    Const sizeof_DIBSECTION As Long = 84
    Const offsetof_bmBits As Long = 20
    Dim baBuffer(0 To sizeof_DIBSECTION - 1) As Byte
    
    Call ApiGetObject(hDib, UBound(baBuffer) + 1, baBuffer(0))
    Call CopyMemory(GetDIBPointer, baBuffer(offsetof_bmBits), 4)
End Function

After you retrieve this pointer to DIB pixel data you can use some of the VB6 array overlaying approaches already discussed here. Just map a one dimensional, 2D, 3D or whatever array you prefer without copying any pixel data in the process.

cheers,
</wqw>

[xiaoyao]

picture from stream,or byte array,it's very nice.
change bmp or cut screen picture ,Convert bitmap to JPG, and then transfer it to another computer through remote network, saving a lot of broadband.
The transparent PNG image can be combined with BMP and then compressed into jpg
If only a small number of watermark regions are added, the operation speed will greatly save time

[JAAFAR]

GetDIBits and SetDIBits actually *copy* DIB pixel data from/to the system DIB pixel buffer into a separate user-provided "offline" buffer.

When you call CreateDIBSection the system allocates an "array" of memory for the pixel data and returns a pointer to it in lpvBits output parameter. You can use this pointer to access the "online" buffer of the DIB, i.e. when you modify a pixel it's immediately reflected in the DIB and you can see the change when you paint the DIB. With "offline" buffer from GetDIBits you have to first modify the pixel, then upload the changes with SetDIBits which is slow and not something you want to do in a loop. So the best way to read and *modify* the pixels of a DIB is to use the pointer to the "online" buffer of pixel data.

Here is a function which can retrieve the original pointer as returned by CreateDIBSection when you only have the handle to the DIB from an StdPicture or similar.

Option Explicit

Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (lpDst As Any, lpSrc As Any, ByVal ByteLength As Long)
Private Declare Function ApiGetObject Lib "gdi32" Alias "GetObjectA" (ByVal hObject As Long, ByVal nCount As Long, lpObject As Any) As Long

Public Function GetDIBPointer(ByVal hDib As Long) As Long
    Const sizeof_DIBSECTION As Long = 84
    Const offsetof_bmBits As Long = 20
    Dim baBuffer(0 To sizeof_DIBSECTION - 1) As Byte
    
    Call ApiGetObject(hDib, UBound(baBuffer) + 1, baBuffer(0))
    Call CopyMemory(GetDIBPointer, baBuffer(offsetof_bmBits), 4)
End Function

After you retrieve this pointer to DIB pixel data you can use some of the VB6 array overlaying approaches already discussed here. Just map a one dimensional, 2D, 3D or whatever array you prefer without copying any pixel data in the process.

cheers,
</wqw>

Thanks, I have been studying this and this is what I have come up with but, I am getting a null ptr when trying to retrieve the DIB pointer using your function.

FYI, I am actually fetching the DIB data from the clipboard (CF_DIB) and I am using x64 bit hence the LongLong Type .

Do you think I am doing this the right way in the following code? (BTW, your GetDIBPointer function is at the bottom - I just slightly amended it by copying 8 bytes instead of 4bytes so it works in x64bit))

Sub TestForDIBPointer()
    MsgBox GetDIBPointer(GetDIBHandle)  '<== Fails returns 0
End Sub

Function GetDIBHandle() As LongLong

    Const CF_DIB = 8
    Const GMEM_MOVEABLE = &H2
    Const GMEM_ZEROINIT = &H40
    Const GMEM_SHARE = &H2000
    
    Dim hClip As LongLong
    Dim lMem As LongLong
    Dim lMemPtr As LongLong
    
    Dim tBMP As BITMAPINFO

    If OpenClipboard(0) Then
        If IsClipboardFormatAvailable(CF_DIB) Then
            hClip = GetClipboardData(CF_DIB)
            CopyMemory tBMP, ByVal hClip, LenB(tBMP)
            lMem = GlobalAlloc(GMEM_MOVEABLE Or _
            GMEM_SHARE Or GMEM_ZEROINIT, tBMP.bmiHeader.biSize + tBMP.bmiHeader.biSizeImage)
            lMemPtr = GlobalLock(lMem)
            If lMemPtr Then
                GetDIBHandle = lMemPtr
            End If
        End If
    End If

    Call GlobalUnlock(lMem)
    CloseClipboard
    
End Function

Function GetDIBPointer(ByVal hDib As LongLong) As LongLong
    Const sizeof_DIBSECTION As Long = 84
    Const offsetof_bmBits As Long = 20
    Dim baBuffer(0 To sizeof_DIBSECTION - 1) As Byte
    
    Call ApiGetObject(hDib, UBound(baBuffer) + 1, baBuffer(0))
    Call CopyMemory(GetDIBPointer, baBuffer(offsetof_bmBits), 8)
End Function

[JAAFAR]

picture from stream,or byte array,it's very nice.
change bmp or cut screen picture ,Convert bitmap to JPG, and then transfer it to another computer through remote network, saving a lot of broadband.
The transparent PNG image can be combined with BMP and then compressed into jpg
If only a small number of watermark regions are added, the operation speed will greatly save time

Thanks xiaoyao but, I am actually trying to make wqweto's code work just for sake of learning.

[wqweto]

Thanks, I have been studying this and this is what I have come up with but, I am getting a null ptr when trying to retrieve the DIB pointer using your function.

FYI, I am actually fetching the DIB data from the clipboard (CF_DIB) and I am using x64 bit hence the LongLong Type .

Do you think I am doing this the right way in the following code?

I just recompiled my C/C++ project that I use to come up with sizes and offsets in GDI API structs and here is what came up for x64

sizeof(DIBSECTION)=104
offset(bmBits)=24

You have to tweak the function constants with conditional compilation if you are going to use it in both 32/64 bitness.

Also, note that GetDIBPointer will return NULL for any GDI object type besides DIB e.g. device-dependant bitmaps, font (!) handles, etc. because ApiGetObject will fail and baBuffer will remain empty.

cheers,
</wqw>

[JAAFAR]

I just recompiled my C/C++ project that I use to come up with sizes and offsets in GDI API structs and here is what came up for x64

sizeof(DIBSECTION)=104
offset(bmBits)=24

You have to tweak the function constants with conditional compilation if you are going to use it in both 32/64 bitness.

Also, note that GetDIBPointer will return NULL for any GDI object type besides DIB e.g. device-dependant bitmaps, font (!) handles, etc. because ApiGetObject will fail and baBuffer will remain empty.

cheers,
</wqw>

Function GetDIBPointer(ByVal hDib As LongLong) As LongLong
    Const sizeof_DIBSECTION As Long = 104 ' 84
    Const offsetof_bmBits As Long = 24 ' 20
    Dim baBuffer(0 To sizeof_DIBSECTION - 1) As Byte
    Call ApiGetObject(hDib, UBound(baBuffer) + 1, baBuffer(0))
    Call CopyMemory(GetDIBPointer, baBuffer(offsetof_bmBits), 8)
End Function

Doesn't work ...I still get a null DIB pointer

Am I allocating the global memory correctly in the GetDIBHandlle routine ?
ie : tBMP.bmiHeader.biSize + tBMP.bmiHeader.biSizeImage

[wqweto]

Am I allocating the global memory correctly in the GetDIBHandlle routine ?

No, you have to use CreateDIBSection to create an hDib. Here is a working sample code:

Option Explicit

Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)
Private Declare Function ArrPtr Lib "msvbvm60" Alias "VarPtr" (Ptr() As Any) As Long
Private Declare Function IsClipboardFormatAvailable Lib "user32" (ByVal wFormat As Long) As Long
Private Declare Function OpenClipboard Lib "user32" (ByVal hwnd As Long) As Long
Private Declare Function CloseClipboard Lib "user32" () As Long
Private Declare Function GetClipboardData Lib "user32" (ByVal wFormat As Long) As Long
Private Declare Function GlobalLock Lib "kernel32" (ByVal hMem As Long) As Long
Private Declare Function GlobalSize Lib "kernel32" (ByVal hMem As Long) As Long
Private Declare Function GlobalUnlock Lib "kernel32" (ByVal hMem As Long) As Long
Private Declare Function LoadImage Lib "user32" Alias "LoadImageA" (ByVal hInst As Long, ByVal lpszName As String, ByVal lType As Long, ByVal cxWidth As Long, ByVal cyHeight As Long, ByVal fuLoad As Long) As Long
Private Declare Function GetTempFileName Lib "kernel32" Alias "GetTempFileNameA" (ByVal lpszPath As String, ByVal lpPrefixString As String, ByVal wUnique As Long, ByVal lpTempFileName As String) As Long
Private Declare Function ApiGetObject Lib "gdi32" Alias "GetObjectA" (ByVal hObject As Long, ByVal nCount As Long, lpObject As Any) As Long
Private Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long
Private Declare Function CreateCompatibleDC Lib "gdi32" (ByVal hDC As Long) As Long
Private Declare Function DeleteDC Lib "gdi32" (ByVal hDC As Long) As Long
Private Declare Function SelectObject Lib "gdi32" (ByVal hDC As Long, ByVal hObject As Long) As Long
Private Declare Function AlphaBlend Lib "msimg32" (ByVal hDestDC As Long, ByVal lX As Long, ByVal lY As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hSrcDC As Long, ByVal xSrc As Long, ByVal ySrc As Long, ByVal widthSrc As Long, ByVal heightSrc As Long, ByVal blendFunct As Long) As Boolean

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 Long
    biYPelsPerMeter     As Long
    biClrUsed           As Long
    biClrImportant      As Long
End Type

Private Type SAFEARRAYBOUND
    cElements           As Long
    lLbound             As Long
End Type

Private Type SAFEARRAY
    cDims               As Integer
    fFeatures           As Integer
    cbElements          As Long
    cLocks              As Long
    pvData              As Long
    Bounds(0 To 3)      As SAFEARRAYBOUND
End Type

Private Sub Form_Click()
    Const CF_DIB        As Long = 8
    Dim baData()        As Byte
    Dim hDib            As Long
    Dim lpBits          As Long
    Dim lWidth          As Long
    Dim lHeight         As LoadPictureColorConstants
    Dim aBuffer()       As Long
    Dim uArray          As SAFEARRAY
    Dim lX              As Long
    Dim lY              As Long
    
    If Not GetClipData(CF_DIB, baData) Then
        GoTo QH
    End If
    hDib = GetDIBHandle(baData)
    lpBits = GetDIBPointer(hDib)
    If Not pvGetDibDimension(hDib, lWidth, lHeight) Then
        GoTo QH
    End If
    pvInitOverlayArray aBuffer, uArray, lpBits, lWidth, lHeight
    For lY = 0 To lHeight - 1
        For lX = 0 To lWidth - 1
            aBuffer(lX, lY) = aBuffer(lX, lY) Or &HFF000000
            '--- key out white (#FFFFFF) by setting pixel alpha+color to 0
            If aBuffer(lX, lY) = &HFFFFFFFF Then
                aBuffer(lX, lY) = 0
            End If
        Next
    Next
    pvPaintDib hDC, hDib, 0, 0
    Print "hDib=&H" & Hex$(hDib)
    Print "lpBits=&H" & Hex$(lpBits)
    Call DeleteObject(hDib)
QH:
End Sub

Private Function GetClipData(ByVal lFormat As Long, baData() As Byte) As Boolean
    Dim hMem            As Long
    Dim lPtr            As Long
    Dim lSize           As Long
    
    If IsClipboardFormatAvailable(lFormat) = 0 Then
        GoTo QH
    End If
    If OpenClipboard(0) = 0 Then
        GoTo QH
    End If
    hMem = GetClipboardData(lFormat)
    lPtr = GlobalLock(hMem)
    lSize = GlobalSize(hMem)
    If lSize > 0 Then
        ReDim baData(0 To lSize - 1) As Byte
        Call CopyMemory(baData(0), ByVal lPtr, lSize)
    Else
        baData = vbNullString
    End If
    Call GlobalUnlock(hMem)
    Call CloseClipboard
    '--- success
    GetClipData = True
QH:
End Function

Private Function GetDIBHandle(baData() As Byte) As Long
    Const IMAGE_BITMAP          As Long = 0
    Const LR_LOADFROMFILE       As Long = &H10
    Const LR_CREATEDIBSECTION   As Long = &H2000
    Dim baHeader()      As Byte
    Dim sFile           As String
    
    sFile = String$(1000, 0)
    Call GetTempFileName(Environ$("TEMP"), "test", 0, sFile)
    sFile = Left$(sFile, InStr(sFile, vbNullChar) - 1)
    ReDim baHeader(0 To 13) As Byte
    Call CopyMemory(baHeader(0), &H4D42, 2) '--- "BM"
    Call CopyMemory(baHeader(2), UBound(baHeader) + 1 + UBound(baData) + 1, 4)
    WriteBinaryFile sFile, baHeader, baData
    GetDIBHandle = LoadImage(0, sFile, IMAGE_BITMAP, 0, 0, LR_LOADFROMFILE Or LR_CREATEDIBSECTION)
    Kill sFile
End Function

Private Function GetDIBPointer(ByVal hDib As Long) As Long
    Const sizeof_DIBSECTION As Long = 84
    Const offsetof_bmBits As Long = 20
    Dim baBuffer(0 To sizeof_DIBSECTION - 1) As Byte
    
    Call ApiGetObject(hDib, UBound(baBuffer) + 1, baBuffer(0))
    Call CopyMemory(GetDIBPointer, baBuffer(offsetof_bmBits), 4)
End Function

Private Sub WriteBinaryFile(sFile As String, baHeader() As Byte, baBuffer() As Byte)
    Dim nFile           As Integer
    
    nFile = FreeFile
    Open sFile For Binary Access Write Shared As nFile
    If UBound(baHeader) >= 0 Then
        Put nFile, , baHeader
    End If
    If UBound(baBuffer) >= 0 Then
        Put nFile, , baBuffer
    End If
    Close nFile
End Sub

Private Function pvGetDibDimension(ByVal hDib As Long, lWidth As Long, lHeight As Long) As Boolean
    Dim uHdr            As BITMAPINFOHEADER
    
    Call ApiGetObject(hDib, LenB(uHdr), uHdr)
    If uHdr.biWidth = 0 Or uHdr.biHeight = 0 Then
        GoTo QH
    End If
    lWidth = uHdr.biWidth
    lHeight = Abs(uHdr.biHeight)
    '--- success
    pvGetDibDimension = True
QH:
End Function

Private Sub pvInitOverlayArray( _
            aBuffer() As Long, _
            uArray As SAFEARRAY, _
            ByVal lDataPtr As Long, _
            ParamArray Bounds() As Variant)
    Dim lIdx            As Long
    
    Debug.Assert UBound(Bounds) <= UBound(uArray.Bounds)
    With uArray
        .cDims = UBound(Bounds) + 1
        .fFeatures = 1 ' FADF_AUTO
        .cbElements = 4 ' sizeof COLORQUAD
        .cLocks = 1
        .pvData = lDataPtr
        If .cDims = 0 Then
            .cDims = 1
            .Bounds(0).cElements = &H40000000
        Else
            For lIdx = 0 To UBound(Bounds)
                .Bounds(lIdx).cElements = Bounds(UBound(Bounds) - lIdx)
            Next
        End If
    End With
    Call CopyMemory(ByVal ArrPtr(aBuffer), VarPtr(uArray), 4)
End Sub

Private Function pvPaintDib(ByVal hDC As Long, ByVal hDib As Long, ByVal lX As Long, ByVal lY As Long, Optional ByVal Opacity As Long = 255) As Boolean
    Const AC_SRC_ALPHA  As Long = 1
    Dim lWidth          As Long
    Dim lHeight         As Long
    Dim hMemDC          As Long
    Dim hPrevBmp        As Long
    
    If Not pvGetDibDimension(hDib, lWidth, lHeight) Then
        GoTo QH
    End If
    hMemDC = CreateCompatibleDC(0)
    hPrevBmp = SelectObject(hMemDC, hDib)
    If AlphaBlend(hDC, lX, lY, lWidth, lHeight, hMemDC, 0, 0, lWidth, lHeight, AC_SRC_ALPHA * &H1000000 + Opacity * &H10000) = 0 Then
        GoTo QH
    End If
    '--- success
    pvPaintDib = True
QH:
    If hMemDC <> 0 Then
        Call SelectObject(hMemDC, hPrevBmp)
        Call DeleteDC(hMemDC)
    End If
End Function

This save CF_DIB as a BMP file, loads this BMP file to a device-independant hDib and retrieves the lpBits pointer for direct pixel data manipulation.

cheers,
</wqw>

[JAAFAR]

wqweto,

I seem to have managed to create the bmp temp file successfully, so thanks a million for that !

I am now trying to retrieve the pixel data values out of the DIB pointer (lpBits) into a 2D array but, the 2D array is always populated with zeros .

This is what I am doing : (This is just a small test for retrieving the first 1000 x 2 individual pixes )

        ReDim D2Array(1000, 2) As Byte
        Call CopyMemory(D2Array(0, 0), ByVal lpBits, 8) '<=Copied bytes Length is 8 bytes in x64bit
        Dim i As Long
        For i = 1 To UBound(D2Array, 1)
            Debug.Print D2Array(i, 0)  '<== returns 0           
        Next i

Thi is new stuff to me and I am trying to learn by examples so I am sure I am doing something terribly wrong.

[wqweto]

I just updated the sample above with some function from this thread.

pvInitOverlayArray can be used to "overlay" a VB6 array or random type over DIB's lpBits with a 1D, 2D or more (up to 4D). The idea of this operation is that no data is copied but just the VB6 array is "redirected" at the data that lpBits points to. FADF_AUTO flag prevents array data being deallocated when the variable goes out of scope (prevents crashes).

pvGetDibDimension and pvPaintDib are self explanatory, the latter alpha-blends the 32-bit DIB so requires precomputed alpha (meaning A >= R, G or B)

cheers,
</wqw>

[The trick]

Why not use GetDiBits?

[wqweto]

Why not use GetDiBits?

OP does not even have to use this as he already has the data from GetClipboardData(CF_DIB) available and can just use CopyMemory at this stage.

In the pincipled sample code above GetDIBPointer function can get the lpBits pointer from any hDib and then a 2D VB array is overlaid without copying any pixel data in the process.

The idea is *not* to use GetDiBits/CopyMemory because after the pixel data is manipulated in the VB array OP will need to copy it back to the DIB with SetDiBits/CopyMemory which is skipped altogether in the lpBits overlay approach.

cheers,
</wqw>

[The trick]

he already has the data from GetClipboardData(CF_DIB)

Okay, now i understand. Thanks.

[JAAFAR]

I just updated the sample above with some function from this thread.

pvInitOverlayArray can be used to "overlay" a VB6 array or random type over DIB's lpBits with a 1D, 2D or more (up to 4D). The idea of this operation is that no data is copied but just the VB6 array is "redirected" at the data that lpBits points to. FADF_AUTO flag prevents array data being deallocated when the variable goes out of scope (prevents crashes).

pvGetDibDimension and pvPaintDib are self explanatory, the latter alpha-blends the 32-bit DIB so requires precomputed alpha (meaning A >= R, G or B)

cheers,
</wqw>

Thank you for your help with this ... I'll actually need some time to carefully study the updated code in order to properly understand it.

I am currently doing some reading on the subject of BMPs, DIBs, DIBSECTION etc so that I can better mentally visualize the inner memory layouts\manipulations.