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.