Simplified GetDiBits

When one wants to manipulate individual pixels of a bitmap then retrieving the colors using GetDiBits via a BITMAPINFO template is a well known way of doing this. One problem when the template bit depth parameter biBitCount is set to 24 is that pad bytes may get added to each scan line because scanlines have to align on 32 bit boundaries. This has to be taken into account when retrieving/setting pixel colors.

A simple method of "avoiding" pad bytes is to use a bit depth of 32 in the template. Setting biBiCount to 32 automatically ensures alignment but the penalty is that more memory is required.


Type BITMAPINFOHEADER    '40 bytes
   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

Type RGBQUAD
   rgbBlue As Byte
   rgbGreen As Byte
   rgbRed As Byte
   rgbReserved As Byte
End Type

Type BITMAP    '24 bytes
  bmType As Long
  bmWidth As Long
  bmHeight As Long
  bmWidthBytes As Long
  bmPlanes As Integer
  bmBitsPixel As Integer
  bmBits As Long
End Type

Type BITMAPINFO
  bmiHeader As BITMAPINFOHEADER
  bmiColors As RGBQUAD
End Type

Type COLORQUAD
  rgbB As Byte
  rgbG As Byte
  rgbR As Byte
  rgbP As Byte
End Type

Public Const BI_RGB = 0&
Public Const DIB_RGB_COLORS = 0&
Public Const LR_LOADFROMFILE = &H10
Public Const IMAGE_BITMAP = 0&

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
Public Declare Function LoadImage Lib "user32" _
       Alias "LoadImageA" (ByVal
hInst As Long, ByVal lpsz As String, ByVal un1 As Long, ByVal n1 As
Long, ByVal n2 As Long, ByVal un2 As Long) As Long
Public Declare Function CreateCompatibleDC Lib "gdi32" _
       (ByVal hdc As Long) As Long
Public Declare Function DeleteDC Lib "gdi32" (ByVal hdc _
       As Long) As Long
Public Declare Function SelectObject Lib "gdi32" (ByVal _
       hdc As Long, ByVal hObject As Long) As Long
Public Declare Function DeleteObject Lib "gdi32" _
       (ByVal hObject As Long) As Long
Public Declare Function GetObject Lib "gdi32" Alias _
       "GetObjectA" (ByVal
hObject As Long, ByVal nCount As Long, lpObject As Any) As Long
Public Declare Function StretchBlt 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
nSrcWidth As Long, ByVal nSrcHeight As Long, ByVal dwRop As Long) As
Long
Declare Function SetDIBits 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

  Dim hand As Long, oldhand As Long
  Dim bmap As BITMAP
  Dim srcewid As Long, srcehgt As Long
  Dim srcedibbmap As BITMAPINFO
  Dim BytesPerScanLine As Long
  Dim PadBytesPerScanLine As Long
  Dim icol As Integer, irow As Integer
  Dim lsuccess As Long
  Dim hdcNew As Long
  Dim srceqarr() As COLORQUAD
  Dim thiscolor As COLORQUAD

  'Load bitmap data from disk
  hand = LoadImage(0, FileName, IMAGE_BITMAP, 0, 0, LR_LOADFROMFILE)

  'Fill out the BITMAP structure.
  lsuccess = GetObject(hand, Len(bmap), bmap)

  'Create a device context compatible with the Desktop.
  hdcNew = CreateCompatibleDC(0&)

  'Select the bitmap handle into the new device context.
  oldhand = SelectObject(hdcNew, hand)

  'Get the source bitmap width and height, in pixels, from BITMAP
  'structure.
  srcewid = bmap.bmWidth
  srcehgt = bmap.bmHeight

  'srcedibbmap has been dimensioned as BITMAPINFO structure so
  'fill it out to create a template.
  'Two useful equations are those for BytesPerScanLine and
  'PadBytesPerScanLine. They work for any bit depth.
  'PadBytesPerScanLine will always be zero with biBiCount = 32
  'biheight is set negative to invert the "bottom up" scanline
  'reading.

  With srcedibbmap.bmiHeader
    .biSize = 40
    .biWidth = srcewid
    .biHeight = -srcehgt
    .biPlanes = 1
    .biBitCount = 32
    .biCompression = BI_RGB
    BytesPerScanLine = ((((.biWidth * .biBitCount) + 31) \ 32) * 4)
    PadBytesPerScanLine = _
      BytesPerScanLine - (((.biWidth * .biBitCount) + 7) \ 8)
    .biSizeImage = BytesPerScanLine * Abs(.biHeight)
  End With

  'Dimension the array receiving data. COLORQUAD is used just
  'to differentiate it from RGBQUAD.
  ReDim srceqarr(1 To srcewid, 1 To srcehgt)

  'Get color data from the source into a dib based on the template
  lsuccess = GetDIBits(hdcNew, hand, 0, srcehgt, srceqarr(1, 1), _
             srcedibbmap, DIB_RGB_COLORS)

  'StretchBlt to PictureBox so we can see the bitmap
  'PictureBox has Scalemode Pixels and AutoRedraw True
  lsuccess = StretchBlt(Picture1.hdc, _
        0, 0, Picture1.ScaleWidth, _ 
        Picture1.ScaleHeight, _
        hdcNew, _
        0, 0, srcewid, srcehgt, _
        vbSrcCopy)
  Picture1.Refresh

  'Retrieve the colors
  For irow = 1 To srcehgt
    For icol = 1 To srcewid
    thiscolor = srceqarr(icol, irow)
    Next
  Next

  'It may be more convenient to think of the bitmap as a 3D array
  'with a blue, green, and red plane plus a fourth "don't care"
  ' plane

  Dim Array3D() As Byte
  ReDim Array3D(1 To 4, 1 To srcewid, 1 To srcehgt)
  Dim ipixel as Integer, iscanline as Integer
  Dim thisred As Byte, thisgreen As Byte, thisblue As Byte

  lsuccess = GetDIBits(hdcNew, hand, 0, srcehgt, _
     Array3D(1, 1, 1), srcedibbmap, DIB_RGB_COLORS)

 'Change all White pixels in bitmap to Blue
  For ipixel = 1 To srcewid
    For iscanline = 1 To srcehgt
      thisblue = Array3D(1, ipixel, iscanline)
      thisgreen = Array3D(2, ipixel, iscanline)
      thisred = Array3D(3, ipixel, iscanline)
      If (thisblue = 255) And (thisgreen = 255) And _
         (thisred = 255) Then
    Array3D(2, ipixel, iscanline) = 0
    Array3D(3, ipixel, iscanline) = 0
  End If
  Next
  Next

  lsuccess = SetDIBits(hdcNew, hand, 0, srcehgt, _
         Array3D(1, 1, 1), srcedibbmap, DIB_RGB_COLORS)

  'StretchBlt to PictureBox so we can see the result
  lsuccess = StretchBlt(Picture1.hdc, _
             0, 0, Picture1.ScaleWidth, _
             Picture1.ScaleHeight, _
             hdcNew, _
             0, 0, srcewid, srcehgt, _
             vbSrcCopy)

  Picture1.Refresh

  'Clean up
  SelectObject hdcNew, oldhand
  DeleteObject hand
  DeleteDC hdcNew

  'Clean up
  SelectObject hdcNew, oldhand
  DeleteObject hand
  DeleteDC hdcNew



Comments

  • forget 1 information like other tutorials that i can't find it:(

    Posted by joaquim on 07/08/2012 12:56pm

    you create the array easy do that;) but how connect that array with GetDIBits() API function and with srcedibbmap.bmiHeader structure? i read several tutorials but they show us the example and not how use GetDIBits() API function and with srcedibbmap.bmiHeader structure:( thanks

    Reply
  • How to store bitmap into BLOB in Oracle using VB

    Posted by Legacy on 01/11/2001 12:00am

    Originally posted by: P.SrinvasaReddy

    I am trying to insert bitmap into BLOB field of Oracle using VB6.0(using Remote Data Object).But I couldn't.
    Can u help me..

    Reply
  • Simplified GetDiBits

    Posted by Legacy on 09/20/2000 12:00am

    Originally posted by: Les Marshall

    Useful code

    Reply
Leave a Comment
  • Your email address will not be published. All fields are required.

Top White Papers and Webcasts

  • Java developers know that testing code changes can be a huge pain, and waiting for an application to redeploy after a code fix can take an eternity. Wouldn't it be great if you could see your code changes immediately, fine-tune, debug, explore and deploy code without waiting for ages? In this white paper, find out how that's possible with a Java plugin that drastically changes the way you develop, test and run Java applications. Discover the advantages of this plugin, and the changes you can expect to see …

  • Managing your company's financials is the backbone of your business and is vital to the long-term health and viability of your company. To continue applying the necessary financial rigor to support rapid growth, the accounting department needs the right tools to most efficiently do their job. Read this white paper to understand the 10 essentials of a complete financial management system and how the right solution can help you keep up with the rapidly changing business world.

Most Popular Programming Stories

More for Developers

Latest Developer Headlines

RSS Feeds