Ever tried to make a picture darker or fade it to the background? Using PSet() and looping through each pixel is incredible slow. SetPixel() is faster but still too slow to be serious. Well the fastest possible way to do this is still some ASM code but I'll show you a moderable fast way in VB. What we're going to do is getting the whole bitmap data in one API call, edit the data and then put it back to the picture.
DIB stands for device independant bitmap and it's just how windows handles your bitmaps internally. There is only one little problem with DIBs: They're stored upside-down. Well this doesn't matter if we're looping through any pixel but it does whenever we need to set a pixel at a certain position. However it's quite simple to get around this, but you should always mention it.
Now don't be scared of the following bunch of code! It's just the API Types and Declares we need, you can get this from your API Viewer or from MSDN.
'Types
Private Type tBitmapInfoHeader
Size as Long
W as Long
H as Long
Planes as Integer
ColorDepth as Integer
Compression as Long
SizeImage as Long
xPPM as Long
yPPM as Long
UsedColosr as Long
ImportantColors as Long
End Type
Private Type tColorRGBA
B as Byte
G as Byte
R as Byte
A as Byte
End Type
Private Type tBitmap
Type as Long
W as Long
H as Long
WidthBytes as Long
Planes as Integer
ColorDepth as Integer
Bits as Long
End Type
Private Type tBitmapInfo
Header as tBitmapInfoHeader
Colors as tColorRGBA
End Type
'Declares
Private Declare Function CreateCompatibleDC Lib "gdi32" ( ByVal iDC as Long ) as Long
Private Declare Function DeleteDC Lib "gdi32" ( ByVal iDC as Long ) as Long
Private Declare Function GetObjectAPI Lib "gdi32" Alias "GetObjectA" ( ByVal Object as Long, _
ByVal Count as Long, Target as Any ) as Long
Private Declare Function GetDIBits Lib "gdi32" ( ByVal iDC as Long, ByVal iBitmap as Long, _
ByVal iStartScan as Long, ByVal iNumScans as Long, iBits as Any, iBitmapInfo as tBitmapInfo, _
ByVal iUsage as Long ) as Long
Private Declare Function SetDIBits Lib "gdi32" ( ByVal iDC as Long, ByVal iBitmap as Long, _
ByVal iStartScan as Long, ByVal iNumScans as Long, iBits as Any, iBitmapInfo as tBitmapInfo, _
ByVal iUsage as Long ) as Long
That's it, we can start working with these functions. The following sample code gets the bitmap data from the passed DC and Handle and converts the contents to a b/w mask. Basically it just goes through all pixels and checks their color, then setting a specified color value at this position.
Private Sub ConvertMask( ByVal iSourceDC as Long, ByVal iSourceHandle as Long )
Dim A as Long
Dim Temp as Long
Dim Data() as tColorRGBA
Dim TempBitmapInfo as tBitmapInfo
Dim TempBitmap as tBitmap
Dim TempDC as Long
'Get DC and attach to target
TempDC = CreateCompatibleDC( iSourceDC )
GetObjectAPI iSourceHandle, Len( TempBitmap ), TempBitmap
'Setup bitmap info
With TempBitmapInfo.Header
'Internal setup
.ColorDepth = TempBitmap.ColorDepth
.Planes = TempBitmap.Planes
.Size = 40
'Get size
.W = TempBitmap.W
.H = TempBitmap.H
'Create data buffer
ReDim Data( ( .W * .H ) - 1 )
End With
'Get bitmap data (note that it's top-down)
GetDIBits TempDC, iSourceHandle, 0, TempBitmap.H, Data( 0 ), TempBitmapInfo, 0
Now the data array is filled and read to use. The next part creates the mask by looping through each pixel, checking it's color and if it's white set it to black, otherwise set it to white. There's nothing special about this code.
'Edit data
For A = 0 To UBound( Data )
With Data( A )
'Check pixel color
If .R = 255 And .G = 255 And .B = 255 Then
'It was white -> set it to black
.R = 0
.G = 0
.B = 0
Else
'It was not white -> set it to white
.R = 255
.G = 255
.B = 255
End If
End With
Next
Now the following part you don't have to include! It only shows you how to access a certain pixel, the important part here is the position conversion from 2D coordinates into top-down coordinates and the into a 1 dimensional index position. This is all done in the first line of the following code:
'Get position (X = 5, Y = 10)
Temp = ( TempBitmap.H - 10 ) * TempBitmap.W + 5
'Set a blue pixel there
Data( Temp ).R = 0
Data( Temp ).G = 0
Data( Temp ).B = 255
We're done manipulating the bitmap now and the data can be written back to the original object. This is done in the last part of this function:
'Write data back
SetDIBits iSourceDC, iSourceHandle, 0, TempBitmap.H, Data( 0 ), TempBitmapInfo, 0
'Release DC from target
DeleteDC TempDC
End Sub
Note that after calling the function you'll have to refresh the display so the changes get visible:
Private Sub cmdConvert_Click()
'Create mask
ConvertMask picSource.hdc, picSource.Image.Handle
'Update display
picSource.Refresh
End Sub
Getting the DIB bits (or bytes) is a quite fast way to manipulate whole bitmaps at once. It comes handy whenever you have to check each pixel and set a new color. Since DIBs are stored upside-down you have to do a little conversion to get the correct position. Further the data array you get is 1-dimensional (as it should be) so you have to use the well-known formula Y * Width + X to get the index position.
The following sample project is a little modifed, eg. I split up the function in 4 parts:
This was necessary to not waste CPU time when calling the function several times to edit the same picture over and over. As long as we're editing the same picture we don't have to get the DIB bits again so this part was splitted up. I put everything into one stand-alone module you can use in your projects if you like. If you do so I kindly ask you to put me in the credits somewhere, thanks.