Page 1 of 2 12 LastLast
Results 1 to 40 of 48

Thread: Read Bitmap into a 2D array ?

  1. #1

    Thread Starter
    Fanatic Member
    Join Date
    Nov 2013
    Posts
    658

    Read Bitmap into a 2D array ?

    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.

  2. #2

  3. #3

    Thread Starter
    Fanatic Member
    Join Date
    Nov 2013
    Posts
    658

    Re: Read Bitmap into a 2D array ?

    Quote Originally Posted by The trick View Post
    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?
    Code:
     GetDIBits hdc, Picture.Handle, 0, Height, BITS(0, 0), BMI, 0

  4. #4
    PowerPoster
    Join Date
    Jan 2020
    Posts
    3,746

    Re: Read Bitmap into a 2D array ?

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

  5. #5

  6. #6

    Thread Starter
    Fanatic Member
    Join Date
    Nov 2013
    Posts
    658

    Re: Read Bitmap into a 2D array ?

    Quote Originally Posted by The trick View Post
    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.

  7. #7
    PowerPoster wqweto's Avatar
    Join Date
    May 2011
    Location
    Sofia, Bulgaria
    Posts
    5,120

    Re: Read Bitmap into a 2D array ?

    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.

    Code:
    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>

  8. #8
    PowerPoster
    Join Date
    Jan 2020
    Posts
    3,746

    Re: Read Bitmap into a 2D array ?

    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

  9. #9

    Thread Starter
    Fanatic Member
    Join Date
    Nov 2013
    Posts
    658

    Re: Read Bitmap into a 2D array ?

    Quote Originally Posted by wqweto View Post
    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.

    Code:
    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))

    Code:
    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
    Last edited by JAAFAR; Jan 24th, 2021 at 12:59 AM.

  10. #10

    Thread Starter
    Fanatic Member
    Join Date
    Nov 2013
    Posts
    658

    Re: Read Bitmap into a 2D array ?

    Quote Originally Posted by xiaoyao View Post
    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.

  11. #11
    PowerPoster wqweto's Avatar
    Join Date
    May 2011
    Location
    Sofia, Bulgaria
    Posts
    5,120

    Re: Read Bitmap into a 2D array ?

    Quote Originally Posted by JAAFAR View Post
    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

    Code:
    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>

  12. #12

    Thread Starter
    Fanatic Member
    Join Date
    Nov 2013
    Posts
    658

    Re: Read Bitmap into a 2D array ?

    Quote Originally Posted by wqweto View Post
    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

    Code:
    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>
    Code:
    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

  13. #13
    PowerPoster wqweto's Avatar
    Join Date
    May 2011
    Location
    Sofia, Bulgaria
    Posts
    5,120

    Re: Read Bitmap into a 2D array ?

    Quote Originally Posted by JAAFAR View Post
    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:

    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>

  14. #14

    Thread Starter
    Fanatic Member
    Join Date
    Nov 2013
    Posts
    658

    Re: Read Bitmap into a 2D array ?

    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 )
    Code:
            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.

  15. #15
    PowerPoster wqweto's Avatar
    Join Date
    May 2011
    Location
    Sofia, Bulgaria
    Posts
    5,120

    Re: Read Bitmap into a 2D array ?

    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>

  16. #16

  17. #17
    PowerPoster wqweto's Avatar
    Join Date
    May 2011
    Location
    Sofia, Bulgaria
    Posts
    5,120

    Re: Read Bitmap into a 2D array ?

    Quote Originally Posted by The trick View Post
    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>

  18. #18

  19. #19

    Thread Starter
    Fanatic Member
    Join Date
    Nov 2013
    Posts
    658

    Re: Read Bitmap into a 2D array ?

    Quote Originally Posted by wqweto View Post
    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.

  20. #20

    Thread Starter
    Fanatic Member
    Join Date
    Nov 2013
    Posts
    658

    Re: Read Bitmap into a 2D array ?

    Quote Originally Posted by wqweto View Post
    No, you have to use CreateDIBSection to create an hDib. Here is a working sample code:

    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>
    Hi,

    I gave the above a go and the code crashes at the red line :

    Code:
        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 '<== Crash
                '--- 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
    pBits, lWidth, lHeight all return valid values.

    In fact , just querying the first element in the aBuffer array causes a crash:
    Code:
    pvInitOverlayArray aBuffer, uArray, lpBits, lWidth, lHeight
     Debug.Print aBuffer(0, 0)  '<==Crash
    I wonder what might be the cause for the code crashing ... I get no error, just plain crash.

    Thanks.

  21. #21
    PowerPoster wqweto's Avatar
    Join Date
    May 2011
    Location
    Sofia, Bulgaria
    Posts
    5,120

    Re: Read Bitmap into a 2D array ?

    Quote Originally Posted by JAAFAR View Post
    I wonder what might be the cause for the code crashing ...
    As already pointed out function GetDIBPointer is *not* bitness invariant so the sample will not work "as is" in x64 office.

    I already gave the values for sizeof_DIBSECTION and offsetof_bmBits constants for x64 but it's up to you to add the conditional compilation for x86 vs x64.

    cheers,
    </wqw>

  22. #22

    Thread Starter
    Fanatic Member
    Join Date
    Nov 2013
    Posts
    658

    Re: Read Bitmap into a 2D array ?

    Quote Originally Posted by wqweto View Post
    As already pointed out function GetDIBPointer is *not* bitness invariant so the sample will not work "as is" in x64 office.

    I already gave the values for sizeof_DIBSECTION and offsetof_bmBits constants for x64 but it's up to you to add the conditional compilation for x86 vs x64.

    cheers,
    </wqw>

    Oops! Sorry, my bad... I overlooked the x64 values you gave me in post#11.

    All working great.

    Always learning great tips from you guys in this forum. (Array overlay concept)

    Thanks a million for your help and patience wqweto.

  23. #23

    Thread Starter
    Fanatic Member
    Join Date
    Nov 2013
    Posts
    658

    Re: Read Bitmap into a 2D array ?

    I am trying to understand the BLENDFUNCT (last argument) of the AlphaBlend API.

    Code:
    Opacity = 255
    AC_SRC_ALPHA = 1
    Debug.Print Hex((AC_SRC_ALPHA * &H1000000) + (Opacity * &H10000))
    the above returns an HEX value of 01FF0000.

    I see 4 pairs of Byte values .

    Do each byte pair correspond to a bitmap color (RGB) and transparency (ALPHA) ? and if so, wich one is which ?

    Thanks.

  24. #24
    PowerPoster wqweto's Avatar
    Join Date
    May 2011
    Location
    Sofia, Bulgaria
    Posts
    5,120

    Re: Read Bitmap into a 2D array ?

    You can take a look at the struct in the SDK for some member names on these values:

    Code:
    typedef struct _BLENDFUNCTION {
      BYTE BlendOp;
      BYTE BlendFlags;
      BYTE SourceConstantAlpha;
      BYTE AlphaFormat;
    } BLENDFUNCTION, *PBLENDFUNCTION;
    This struct is so small, that the compiler inlines it and passes it on the stack as a 32-bit value instead of passing a 32-bit pointer to it.

    This is the reason why in VB6 this struct value can be "calculated" (more like obfuscated) with bit-shifting similar to the code above.

    cheersm
    </wqw>

  25. #25

    Thread Starter
    Fanatic Member
    Join Date
    Nov 2013
    Posts
    658

    Re: Read Bitmap into a 2D array ?

    Quote Originally Posted by wqweto View Post
    You can take a look at the struct in the SDK for some member names on these values:

    Code:
    typedef struct _BLENDFUNCTION {
      BYTE BlendOp;
      BYTE BlendFlags;
      BYTE SourceConstantAlpha;
      BYTE AlphaFormat;
    } BLENDFUNCTION, *PBLENDFUNCTION;
    This struct is so small, that the compiler inlines it and passes it on the stack as a 32-bit value instead of passing a 32-bit pointer to it.

    This is the reason why in VB6 this struct value can be "calculated" (more like obfuscated) with bit-shifting similar to the code above.

    cheersm
    </wqw>
    Thanks.

    For learning purposes, is it possible to set the bitmap transparency directy by manipulating the DIB data stored in the aBuffer array instead of using AlphaBlend ?

  26. #26
    PowerPoster wqweto's Avatar
    Join Date
    May 2011
    Location
    Sofia, Bulgaria
    Posts
    5,120

    Re: Read Bitmap into a 2D array ?

    Quote Originally Posted by JAAFAR View Post
    For learning purposes, is it possible to set the bitmap transparency directy by manipulating the DIB data stored in the aBuffer array instead of using AlphaBlend ?
    Sure, you can use this for production purposes too.

    Both per-pixel alpha values and SourceConstantAlpha value in BLENDFUNCTION (the Opacity constant above) are multiplied before performing the actual alpha-blending (in hardware or software) of the source (DIB) vs destination (screen) pixels.

    cheers,
    </wqw>

  27. #27

    Thread Starter
    Fanatic Member
    Join Date
    Nov 2013
    Posts
    658

    Re: Read Bitmap into a 2D array ?

    Quote Originally Posted by wqweto View Post
    Sure, you can use this for production purposes too.

    Both per-pixel alpha values and SourceConstantAlpha value in BLENDFUNCTION (the Opacity constant above) are multiplied before performing the actual alpha-blending (in hardware or software) of the source (DIB) vs destination (screen) pixels.

    cheers,
    </wqw>
    This is basically what I am doing to make the image white background tranparent but It is not working... Background stays white :
    Code:
    Private Type RGBA
        R As Byte
        G As Byte
        B As Byte
        Alpha As Byte
    End Type
    
    .............
    ....................
    
    
    Dim tRGBA As RGBA
    
    For lY = 0 To lHeight - 1
        For lX = 0 To lWidth - 1
            If aBuffer(lX, lY) = &HFFFFFFFF Then
                CopyMemory tRGBA, aBuffer(lX, lY), 4
                With tRGBA
                  .Alpha = (aBuffer(lX, lY) And &HFF000000) \ &H1000000 And &HFF
                  .B = (aBuffer(lX, lY) And &HFF0000) \ &H10000
                  .G = (aBuffer(lX, lY) And &HFF00&) \ &H100
                  .R = aBuffer(lX, lY) And &HFF
                End With
                CopyMemory aBuffer(lX, lY), tRGBA, 4
            End If
        Next
    Next
    
    Const SRCCOPY = &HCC0020
    Dim hMemDC As Long, hPrevBmp As Long
    
    hMemDC = CreateCompatibleDC(0)
    hPrevBmp = SelectObject(hMemDC, hDib)
    
    Call BitBlt(hDC, 0, 0, lWidth, lHeight, hMemDC, 0, 0, SRCCOPY)
    I can't seem to make the RGBA alpha member transparent.

  28. #28
    PowerPoster Arnoutdv's Avatar
    Join Date
    Oct 2013
    Posts
    5,872

    Re: Read Bitmap into a 2D array ?

    You are not really setting the .Alpha value.
    You do Alpha = Alpha And &HFF.
    I think you just want .Alpha = &HFF

  29. #29

    Thread Starter
    Fanatic Member
    Join Date
    Nov 2013
    Posts
    658

    Re: Read Bitmap into a 2D array ?

    Quote Originally Posted by Arnoutdv View Post
    You are not really setting the .Alpha value.
    You do Alpha = Alpha And &HFF.
    I think you just want .Alpha = &HFF
    Thanks but that didn't work either to set the Alpha channel of the white background pixels to transparent.

  30. #30
    PowerPoster
    Join Date
    Jan 2020
    Posts
    3,746

    Re: Read Bitmap into a 2D array ?

    TRY GdipBitmapLockBits,I Have test it

    Code:
     
    
    Public Type Argb
        Blue As Byte
        Green As Byte
        Red As Byte
        Alphi As Byte
    End Type
    
    Public Type RgbType
        Blue As Byte
        Green As Byte
        Red As Byte
    End Type
    
    Function GetPicBmpData_Argb(File1 As String) As Argb()
    Dim Bitmap As Long
    Dim RC As RECTL
    Dim Data() As Argb 'DATA(W,H),LONG TYPE= ARGB
    
    GdipCreateBitmapFromFile StrPtr(File1), Bitmap
    GdipGetImageWidth Bitmap, RC.Right
      GdipGetImageHeight Bitmap, RC.Bottom
      
      ReDim Data(RC.Bottom - 1, RC.Right - 1)
    
      Dim BmpData As BitmapData
      Dim FormatID As Long
      FormatID = PixelFormat32bppARGB
    
      With BmpData
        .Width = RC.Right
        .Height = RC.Bottom
        .pixelFormat = FormatID
        .Scan0 = VarPtr(Data(0, 0))
        .Stride = 4 * CLng(RC.Right)
      End With
      GdipBitmapLockBits Bitmap, RC, ImageLockModeUserInputBuf Or ImageLockModeWrite Or ImageLockModeRead, FormatID, BmpData
      GetPicBmpData_Argb = Data()
      GdipDisposeImage Bitmap
    End Function
    only rgb:
    Code:
    Function GetPicBmpData_RGB(File1 As String) As RgbType()
    Dim Bitmap As Long
    Dim RC As RECTL
    Dim Data() As RgbType 'DATA(W,H),LONG TYPE= ARGB
    
    GdipCreateBitmapFromFile StrPtr(File1), Bitmap
    GdipGetImageWidth Bitmap, RC.Right
      GdipGetImageHeight Bitmap, RC.Bottom
      
      ReDim Data(RC.Bottom - 1, RC.Right - 1)
    
      Dim BmpData As BitmapData
      Dim FormatID As Long
      FormatID = PixelFormat24bppRGB
    
      With BmpData
        .Width = RC.Right
        .Height = RC.Bottom
        .pixelFormat = FormatID
        .Scan0 = VarPtr(Data(0, 0))
        .Stride = 3 * CLng(RC.Right)
      End With
      GdipBitmapLockBits Bitmap, RC, ImageLockModeUserInputBuf Or ImageLockModeWrite Or ImageLockModeRead, FormatID, BmpData
      GdipDisposeImage Bitmap
      GetPicBmpData_RGB = Data()
    End Function
    Name:  GetImgARgb.jpg
Views: 576
Size:  58.4 KB
    Last edited by xiaoyao; Mar 22nd, 2021 at 10:56 PM.

  31. #31

    Thread Starter
    Fanatic Member
    Join Date
    Nov 2013
    Posts
    658

    Re: Read Bitmap into a 2D array ?

    @xiaoyao

    Thanks ... I will definitely take a look at your code later. However, I am looking at setting the alpha channel of individual pixels without the help of any supporting API functions -ie:= Just by manipulating the pixel data that I have stored in the array from the DIB.

    I want this just for learning.

  32. #32
    PowerPoster
    Join Date
    Jan 2020
    Posts
    3,746

    Re: Read Bitmap into a 2D array ?

    full code in here:
    Get Argb From Image,Read Bitmap into a 2D array-VBForums
    https://www.vbforums.com/showthread....nto-a-2D-array

  33. #33
    The Idiot
    Join Date
    Dec 2014
    Posts
    2,721

    Re: Read Bitmap into a 2D array ?

    u need to use the dib address as the starting address position, it need to be 32 bit or it will not work.
    after that u need to send that data again to the DC or u will not see anything.

    i created a game that used the dib to check the opacity, this because I wanted the mouse pointer to only highlight on the area that was solid not transparent. but I never worked on setting the opacity, since I didnt need that. quite easy to get, should be the same to set.
    also remember that y need to be multiplied with the bitplane * width (32=4)

    so, if u want the pixel x=100,y=50

    u need to dib address + 100 + 50 * 4 * width + 3
    (3 is the alpha position)

    and use copymemory, just with byte. no need to change the color.

  34. #34
    PowerPoster
    Join Date
    Jan 2020
    Posts
    3,746

    Re: Read Bitmap into a 2D array ?

    Quote Originally Posted by baka View Post
    u need to use the dib address as the starting address position, it need to be 32 bit or it will not work.
    after that u need to send that data again to the DC or u will not see anything.

    i created a game that used the dib to check the opacity, this because I wanted the mouse pointer to only highlight on the area that was solid not transparent. but I never worked on setting the opacity, since I didnt need that. quite easy to get, should be the same to set.
    also remember that y need to be multiplied with the bitplane * width (32=4)

    so, if u want the pixel x=100,y=50

    u need to dib address + 100 + 50 * 4 * width + 3
    (3 is the alpha position)

    and use copymemory, just with byte. no need to change the color.
    if use safearray,maybe quickly

  35. #35
    PowerPoster wqweto's Avatar
    Join Date
    May 2011
    Location
    Sofia, Bulgaria
    Posts
    5,120

    Re: Read Bitmap into a 2D array ?

    Quote Originally Posted by JAAFAR View Post
    However, I am looking at setting the alpha channel of individual pixels without the help of any supporting API functions -ie:= Just by manipulating the pixel data that I have stored in the array from the DIB.
    In the sample above with pvInitOverlayArray there are no "supporting API function" for manipulating pixel data -- only for retrieving DIB's original pointer and setting up native VB6 overlaying array on it (without copying the pixel-data).

    Setting alpha with aBuffer(lX, lY) = aBuffer(lX, lY) Or &HFF000000 directly modifies the DIB pixel-data and there is no need to copy any buffer back to the DIB with SetDIBits for instance or CopyMemory API functions. This VB6 assignment statement is modifying live DIB pixel-data so that painting the hDIB handle reflects the modified pixel-data immediately.

    cheers,
    </wqw>

  36. #36
    PowerPoster
    Join Date
    Jan 2020
    Posts
    3,746

    Re: Read Bitmap into a 2D array ?

    GetDIBits Lib "gdi32"
    GdipBitmapLockBits Lib "GDIPlus"
    which is quickly for read rgb data?all support argb (alpha?)
    i use this code
    Code:
    GdipCreateBitmapFromFileStrPtr(App.Path & "\01.png"), image
    
    GdipBitmapLockBits image, Rct, ImageLockModeUserInputBuf Or ImageLockModeWrite Or ImageLockModeRead, FormatID, BmpData
    how to get rgbinfo fast?
    Last edited by xiaoyao; Mar 23rd, 2021 at 04:58 AM.

  37. #37
    PowerPoster wqweto's Avatar
    Join Date
    May 2011
    Location
    Sofia, Bulgaria
    Posts
    5,120

    Re: Read Bitmap into a 2D array ?

    Quote Originally Posted by xiaoyao View Post
    GetDIBits Lib "gdi32"
    GdipBitmapLockBits Lib "GDIPlus"
    which is quickly for read rgb data?all support argb (alpha?)
    i use this code
    Code:
    GdipCreateBitmapFromFileStrPtr(App.Path & "\01.png"), image
    
    GdipBitmapLockBits image, Rct, ImageLockModeUserInputBuf Or ImageLockModeWrite Or ImageLockModeRead, FormatID, BmpData
    how to get rgbinfo fast?
    If I tell you how to "get rgbinfo fast" we all risk hundreds of SPAM posts in codebank claiming you found it and it's the fastest on your micro-benchmarks. . . so I'll skip this time.

    cheers,
    </wqw>

  38. #38
    PowerPoster
    Join Date
    Jan 2020
    Posts
    3,746

    Re: Read Bitmap into a 2D array ?

    Every day, there are hundreds of posts release, I am just interested in it.
    Maybe my test results are not very accurate, I just test based on existing code, which is a little bit a little.
    After all, VB6 is too old, we can only optimize better algorithms.

  39. #39

    Thread Starter
    Fanatic Member
    Join Date
    Nov 2013
    Posts
    658

    Re: Read Bitmap into a 2D array ?

    Quote Originally Posted by baka View Post
    u need to use the dib address as the starting address position, it need to be 32 bit or it will not work.
    after that u need to send that data again to the DC or u will not see anything.

    i created a game that used the dib to check the opacity, this because I wanted the mouse pointer to only highlight on the area that was solid not transparent. but I never worked on setting the opacity, since I didnt need that. quite easy to get, should be the same to set.
    also remember that y need to be multiplied with the bitplane * width (32=4)

    so, if u want the pixel x=100,y=50

    u need to dib address + 100 + 50 * 4 * width + 3
    (3 is the alpha position)

    and use copymemory, just with byte. no need to change the color.
    Hi baka,

    Do you know of any reading material that explains this in some step by step detail ?

    Thanks.

  40. #40

    Thread Starter
    Fanatic Member
    Join Date
    Nov 2013
    Posts
    658

    Re: Read Bitmap into a 2D array ?

    Quote Originally Posted by wqweto View Post
    Here is a working sample code:
    </wqw>
    Code:
     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
    Hi wqweto,

    Why is it necessary to set both, pixel alpha and pixel color to 0 ?
    Wouldn't it be enough to set only the alpha to 0 regardless of the pixel color ?

    My understanding is that, as long as the alpha is set to 0, the pixel would be transparent independently of the values in the RGB bytes.

    So for example, all the following assignements should have the same effect and make the pixel transparent as long as the first byte (ie:= the alpha byte) is set to 0, but that's not the case:

    aBuffer(lX, lY) = &H00000000
    aBuffer(lX, lY) = &H00FF0000
    aBuffer(lX, lY) = &H0000FF00
    aBuffer(lX, lY) = &H000000FF
    aBuffer(lX, lY) = &H00ABDCFF

    And so on ....

    I am confused

Page 1 of 2 12 LastLast

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •  



Click Here to Expand Forum to Full Width