CodeGuru content and product recommendations are editorially independent. We may make money when you click on links to our partners. Learn More.
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
