Get/Set DIBits

[Sam Finch]

Does anyone know how to use the GetDIBits and SetDIBits API's I've been using Get/Set BitmapBits which apparantly are obsolete, MSDN doesnt make too much sensethough?

[Frans C]

This is how Dan Appleman describes GetDIBits in his api guide:

GetDIBits

VB Declaration

Declare Function GetDIBits& Lib "gdi32" (ByVal aHDC As Long, ByVal hBitmap As _
Long, ByVal nStartScan As Long, ByVal nNumScans As Long, lpBits As Any, lpBI As _
BITMAPINFO, ByVal wUsage As Long)

Description

Copies bits from a bitmap into a device-independent bitmap. GetDIBitsBynum is a type-safe declaration for this function.


aHDC Long—A handle to a device context defining the configuration of the device-dependent bitmap hBitmap.
hBitmap Long—A handle to a source bitmap. This bitmap must not be selected into a device context.

nStartScan Long—The number of the first scan line to copy into the DIB.

nNumScans Long—The number of scan lines to copy.

lpBits Any—A pointer to a buffer to load with the bitmap data in DIB format as specified by lpBI. If zero, lpBI is loaded with the information for the DIB, but no data is retrieved (use ByVal 0 to pass zero as this parameter).

lpBI BITMAPINFO—Structure that describes the format and colors of the lpInitBits DIB. The biSize through biCompression fields of the BITMAPINFOHEADER structure must be initialized. Refer to Appendix B for information on this structure.

wUsage Long—One of the following two constants:DIB_PAL_COLORS: The color table is loaded with an array of 16-bit indexes that are relative to the currently selected palette.DIB_RGB_COLORS: color table is loaded with RGB colors

Return Value

Long—True (nonzero) on success, zero on error. On Windows 95, the return is the number of scan lines returned.

Platform

Windows 95, Windows NT, Win16

Comments

The start scan line is relative to the origin, which is at the lower left corner unless the biHeight field of the BITMAPINFOHEADER structure is negative.


I used this function once, to save a picturebox to bitmap file in a different resolution then the screen settings. I will include the source code here.

Option Explicit
Private Type BITMAP
        bmType As Long
        bmWidth As Long
        bmHeight As Long
        bmWidthBytes As Long
        bmPlanes As Integer
        bmBitsPixel As Integer
        bmBits As Long
End Type
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 RGBQUAD
        rgbBlue As Byte
        rgbGreen As Byte
        rgbRed As Byte
        rgbReserved As Byte
End Type
Private Type BITMAPINFO
        bmiHeader As BITMAPINFOHEADER
        bmiColors(15) As RGBQUAD   '16 colors
End Type
Private Type BITMAPFILEHEADER
        bfType(1) As Byte
        bfSize As Long
        bfReserved1 As Integer
        bfReserved2 As Integer
        bfOffBits As Long
End Type

Private Const BI_RGB = 0&
Private Const GMEM_MOVEABLE = &H2
Private Const DIB_RGB_COLORS = 0

Private Declare Function CreateCompatibleDC Lib "gdi32" (ByVal hdc As Long) As Long
Private Declare Function GetObjectAPI Lib "gdi32" Alias "GetObjectA" (ByVal hObject As Long, ByVal nCount As Long, lpObject As Any) As Long
Private Declare Function GlobalAlloc Lib "kernel32" (ByVal wFlags As Long, ByVal dwBytes As Long) As Long
Private Declare Function GlobalLock Lib "kernel32" (ByVal hMem As Long) As Long
Private Declare Function GetDIBits Lib "gdi32" (ByVal aHDC 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
Private Declare Function GlobalUnlock Lib "kernel32" (ByVal hMem As Long) As Long
Private Declare Function GlobalFree Lib "kernel32" (ByVal hMem As Long) As Long
Private Declare Function DeleteDC Lib "gdi32" (ByVal hdc As Long) As Long
Private Declare Function lwrite Lib "kernel32" Alias "_lwrite" (ByVal hFile As Long, lpBuffer As Any, ByVal wBytes As Long) As Long
Private Declare Function lclose Lib "kernel32" Alias "_lclose" (ByVal hFile As Long) As Long
Private Declare Function lcreat Lib "kernel32" Alias "_lcreat" (ByVal lpPathName As String, ByVal iAttribute As Long) As Long

Public Sub Save4bitPicture(PBox As PictureBox, Dest As String)
Dim tempDC As Long
Dim bm As BITMAP
Dim bi As BITMAPINFO
Dim retVal As Long
Dim bufSize As Long
Dim ghnd As Long
Dim gptr As Long
Dim bmfh As BITMAPFILEHEADER
Dim hFile As Long
Dim Cntr As Integer

    ' Create a temporary memory DC and select into it
    ' the background picture of the picture control.
    tempDC = CreateCompatibleDC(PBox.hdc)
    ' Get the size of the picture bitmap
    retVal = GetObjectAPI(PBox.Image, Len(bm), bm)
    ' Fill the BITMAPINFO for the desired DIB
    bi.bmiHeader.biSize = Len(bi.bmiHeader)
    bi.bmiHeader.biWidth = bm.bmWidth
    bi.bmiHeader.biHeight = bm.bmHeight
    bi.bmiHeader.biPlanes = 1
    ' Set to 24 here to create a 24 bit DIB
    ' Set to 8 here to create an 8 bit DIB
    bi.bmiHeader.biBitCount = 4
    bi.bmiHeader.biCompression = BI_RGB
    ' Now calculate the data buffer size needed
    bufSize = bi.bmiHeader.biWidth

    ' Figure out the number of bytes based on the
    ' number of pixels in each byte. In this case we
    ' really don't need all this code because this example
    ' always uses a 16 color DIB, but the code is shown
    ' here for your future reference
    Select Case bi.bmiHeader.biBitCount
        Case 1
            bufSize = (bufSize + 7) / 8
        Case 4
            bufSize = (bufSize + 1) / 2
        Case 24
            bufSize = bufSize * 3
    End Select
    ' And make sure it aligns on a long boundary
    bufSize = ((bufSize + 3) / 4) * 4
    ' And multiply by the # of scan lines
    bufSize = bufSize * bi.bmiHeader.biHeight
    
    ' Now allocate a buffer to hold the data
    ' We use the global memory pool because this buffer
    ' could easily be above 64k bytes.
    ghnd = GlobalAlloc(GMEM_MOVEABLE, bufSize)
    gptr = GlobalLock(ghnd)
    
    ' now copy the picturebox image to the DIB
    retVal = GetDIBits(tempDC, PBox.Image, 0, bm.bmHeight, ByVal gptr, bi, DIB_RGB_COLORS)
    ' write the bitmapfileheader
    With bmfh
        .bfType(0) = &H42
        .bfType(1) = &H4D   ' the string "BM", I have split the integer into two bytes because the bytes got swapped
        .bfSize = Len(bmfh) + Len(bi) + bufSize
        .bfReserved1 = 0
        .bfReserved2 = 0
        'experiments proved that 14 has to be added, I don't know if this is different at a different color depth
        .bfOffBits = Len(bi) + 14
    End With
    
    ' create the file, I've chosen the api way because
    ' it's an easy way to copy the data block
    hFile = lcreat(Dest, 0)
    ' write the bitmapfileheader to the file,
    ' for some strange reasons the structure can't be copied at once
    retVal = lwrite(hFile, bmfh.bfType(0), 1)
    retVal = lwrite(hFile, bmfh.bfType(1), 1)
    retVal = lwrite(hFile, bmfh.bfSize, 4)
    retVal = lwrite(hFile, bmfh.bfReserved1, 2)
    retVal = lwrite(hFile, bmfh.bfReserved2, 2)
    retVal = lwrite(hFile, bmfh.bfOffBits, 4)
    ' write the bitmapinfo to the file
    retVal = lwrite(hFile, bi, Len(bi))
    ' write the data to the file
    retVal = lwrite(hFile, ByVal gptr, bufSize)
    ' and close the file
    retVal = lclose(hFile)
    ' Dump the global memory block
    retVal = GlobalUnlock(ghnd)
    retVal = GlobalFree(ghnd)
    retVal = DeleteDC(tempDC)
    ' and were done
End Sub

[Sam Finch]

Thanks, I should be able to Get what I need out of that.