The new vbAccelerator Site - more VB and .NET Code and Controls

Replace one Colour with another in a Picture using BitBlt


Steve McMahon(





Other Tips
All Tips
By Date
By Subject

API (33)
Manipulation (3)

Clipboard (3)
Box (5)

Desktop (3)
GDI (13)
Graphics (13)
Internet (2)
Comms (3)

Keyboard (2)
Mouse (1)
Shell (1)
Sprites (1)
Subclassing (3)
Box (2)

Windows (11)
Controls (10)


This tip shows you how to replace one colour with another in a bitmap. This method uses BitBlt to ensure the operation is as speedy as possible, and will run very quickly.

Start a new project in VB. Add a new module, then add the following code to it:

Option Explicit

Private Type RECT
&nbsp &nbsp left As Long
&nbsp &nbsp Top As Long
&nbsp &nbsp Right As Long
&nbsp &nbsp Bottom As Long
End Type
' Creates a memory DC
Private Declare Function CreateCompatibleDC Lib "gdi32" ( _
&nbsp &nbsp ByVal hDC As Long _
&nbsp &nbsp ) As Long
' Creates a bitmap in memory:
Private Declare Function CreateCompatibleBitmap Lib "gdi32" ( _
&nbsp &nbsp ByVal hDC As Long, _
&nbsp &nbsp ByVal nWidth As Long, ByVal nHeight As Long _
&nbsp &nbsp ) As Long
' Places a GDI Object into DC, returning the previous one:
Private Declare Function SelectObject Lib "gdi32" _
&nbsp &nbsp (ByVal hDC As Long, ByVal hObject As Long _
&nbsp &nbsp ) As Long
' Deletes a GDI Object:
Private Declare Function DeleteObject Lib "gdi32" _
&nbsp &nbsp (ByVal hObject As Long _
&nbsp &nbsp ) As Long
' Copies Bitmaps from one DC to another, can also perform
' raster operations during the transfer:
Private Declare Function BitBlt Lib "gdi32" ( _
&nbsp &nbsp ByVal hDestDC As Long, _
&nbsp &nbsp ByVal x As Long, ByVal y As Long, _
&nbsp &nbsp ByVal nWidth As Long, ByVal nHeight As Long, _
&nbsp &nbsp ByVal hSrcDC As Long, _
&nbsp &nbsp ByVal xSrc As Long, ByVal ySrc As Long, _
&nbsp &nbsp ByVal dwRop As Long _
&nbsp &nbsp ) As Long
Private Const SRCCOPY = &HCC0020
Private Const SRCAND = &H8800C6
Private Const SRCPAINT = &HEE0086
Private Const SRCINVERT = &H660046

' Sets the backcolour of a device context:
Private Declare Function SetBkColor Lib "gdi32" (ByVal hDC As Long, ByVal crColor As Long) As Long
' Create a brush of a given colour:
Declare Function CreateSolidBrush Lib "gdi32" ( _
&nbsp &nbsp ByVal crColor As Long _
&nbsp &nbsp ) As Long
' Fills a RECT in a DC with a specified brush
Declare Function FillRect Lib "user32" ( _
&nbsp &nbsp ByVal hDC As Long, _
&nbsp &nbsp lpRect As RECT, _
&nbsp &nbsp ByVal hBrush As Long _
&nbsp &nbsp ) As Long

Public Sub ReplaceColor( _
&nbsp &nbsp &nbsp &nbsp ByRef picThis As PictureBox, _
&nbsp &nbsp &nbsp &nbsp ByVal lFromColour As Long, _
&nbsp &nbsp &nbsp &nbsp ByVal lToColor As Long _
&nbsp &nbsp )
Dim lW As Long
Dim lH As Long
Dim lMaskDC As Long, lMaskBMP As Long, lMaskBMPOLd As Long
Dim lCopyDC As Long, lCopyBMP As Long, lCopyBMPOLd As Long
Dim tR As RECT
Dim hBr As Long
&nbsp &nbsp
&nbsp &nbsp
' Cache the width & height of the picture:
&nbsp &nbsp lW = picThis.ScaleWidth \ Screen.TwipsPerPixelX
&nbsp &nbsp lH = picThis.ScaleHeight \ Screen.TwipsPerPixelY

&nbsp &nbsp
' Create a Mono DC & Bitmap
&nbsp &nbsp If (CreateDC(picThis, lW, lH, lMaskDC, lMaskBMP, lMaskBMPOLd, True)) Then
&nbsp &nbsp &nbsp &nbsp
' Create a DC & Bitmap with the same colour depth
&nbsp &nbsp &nbsp &nbsp ' as the picture:
&nbsp &nbsp &nbsp &nbsp If (CreateDC(picThis, lW, lH, lCopyDC, lCopyBMP, lCopyBMPOLd)) Then
&nbsp &nbsp &nbsp &nbsp &nbsp &nbsp
' Make a mask from the picture which is white in the
&nbsp &nbsp &nbsp &nbsp &nbsp &nbsp ' replace colour area:
&nbsp &nbsp &nbsp &nbsp &nbsp &nbsp SetBkColor picThis.hDC, lFromColour
&nbsp &nbsp &nbsp &nbsp &nbsp &nbsp BitBlt lMaskDC, 0, 0, lW, lH, picThis.hDC, 0, 0, SRCCOPY
&nbsp &nbsp &nbsp &nbsp &nbsp &nbsp &nbsp &nbsp &nbsp &nbsp &nbsp &nbsp
&nbsp &nbsp &nbsp &nbsp &nbsp &nbsp
' Fill the colour DC with the colour we want to replace with
&nbsp &nbsp &nbsp &nbsp &nbsp &nbsp tR.Right = lW: tR.Bottom = lH
&nbsp &nbsp &nbsp &nbsp &nbsp &nbsp hBr = CreateSolidBrush(lToColor)
&nbsp &nbsp &nbsp &nbsp &nbsp &nbsp FillRect lCopyDC, tR, hBr
&nbsp &nbsp &nbsp &nbsp &nbsp &nbsp DeleteObject hBr
&nbsp &nbsp &nbsp &nbsp &nbsp &nbsp
' Turn the colour DC black except where the mask is white:
&nbsp &nbsp &nbsp &nbsp &nbsp &nbsp BitBlt lCopyDC, 0, 0, lW, lH, lMaskDC, 0, 0, SRCAND
&nbsp &nbsp &nbsp &nbsp &nbsp &nbsp
&nbsp &nbsp &nbsp &nbsp &nbsp &nbsp
' Create an inverted mask, so it is black where the
&nbsp &nbsp &nbsp &nbsp &nbsp &nbsp ' colour is to be replaced but white otherwise:
&nbsp &nbsp &nbsp &nbsp &nbsp &nbsp hBr = CreateSolidBrush(&HFFFFFF)
&nbsp &nbsp &nbsp &nbsp &nbsp &nbsp FillRect lMaskDC, tR, hBr
&nbsp &nbsp &nbsp &nbsp &nbsp &nbsp DeleteObject hBr
&nbsp &nbsp &nbsp &nbsp &nbsp &nbsp BitBlt lMaskDC, 0, 0, lW, lH, picThis.hDC, 0, 0, SRCINVERT

&nbsp &nbsp &nbsp &nbsp &nbsp &nbsp
' AND the inverted mask with the picture. The picture
&nbsp &nbsp &nbsp &nbsp &nbsp &nbsp ' goes black where the colour is to be replaced, but is
&nbsp &nbsp &nbsp &nbsp &nbsp &nbsp ' unaffected otherwise.
&nbsp &nbsp &nbsp &nbsp &nbsp &nbsp SetBkColor picThis.hDC, &HFFFFFF
&nbsp &nbsp &nbsp &nbsp &nbsp &nbsp BitBlt picThis.hDC, 0, 0, lW, lH, lMaskDC, 0, 0, SRCAND
&nbsp &nbsp &nbsp &nbsp &nbsp &nbsp &nbsp &nbsp &nbsp &nbsp &nbsp &nbsp
&nbsp &nbsp &nbsp &nbsp &nbsp &nbsp
' Finally, OR the coloured item with the picture. Where
&nbsp &nbsp &nbsp &nbsp &nbsp &nbsp ' the picture is black and the coloured DC isn't,
&nbsp &nbsp &nbsp &nbsp &nbsp &nbsp ' the colour will be transferred:
&nbsp &nbsp &nbsp &nbsp &nbsp &nbsp BitBlt picThis.hDC, 0, 0, lW, lH, lCopyDC, 0, 0, SRCPAINT
&nbsp &nbsp &nbsp &nbsp &nbsp &nbsp picThis.Refresh
&nbsp &nbsp &nbsp &nbsp &nbsp &nbsp
&nbsp &nbsp &nbsp &nbsp &nbsp &nbsp
' Clear up the colour DC:
&nbsp &nbsp &nbsp &nbsp &nbsp &nbsp SelectObject lCopyDC, lCopyBMPOLd
&nbsp &nbsp &nbsp &nbsp &nbsp &nbsp DeleteObject lCopyBMP
&nbsp &nbsp &nbsp &nbsp &nbsp &nbsp DeleteObject lCopyDC
&nbsp &nbsp &nbsp &nbsp &nbsp &nbsp
&nbsp &nbsp &nbsp &nbsp End If
&nbsp &nbsp &nbsp &nbsp
&nbsp &nbsp &nbsp &nbsp
' Clear up the mask DC:
&nbsp &nbsp &nbsp &nbsp SelectObject lMaskDC, lMaskBMPOLd
&nbsp &nbsp &nbsp &nbsp DeleteObject lMaskBMP
&nbsp &nbsp &nbsp &nbsp DeleteObject lMaskDC
&nbsp &nbsp End If
End Sub

Public Function CreateDC( _
&nbsp &nbsp &nbsp &nbsp ByRef picThis As PictureBox, _
&nbsp &nbsp &nbsp &nbsp ByVal lW As Long, ByVal lH As Long, _
&nbsp &nbsp &nbsp &nbsp ByRef lhDC As Long, ByRef lhBmp As Long, ByRef lhBmpOld As Long, _
&nbsp &nbsp &nbsp &nbsp Optional ByVal bMono As Boolean = False _
&nbsp &nbsp ) As Boolean
&nbsp &nbsp
&nbsp &nbsp If (bMono) Then
&nbsp &nbsp &nbsp &nbsp lhDC = CreateCompatibleDC(0)
&nbsp &nbsp Else
&nbsp &nbsp &nbsp &nbsp lhDC = CreateCompatibleDC(picThis.hDC)
&nbsp &nbsp End If
&nbsp &nbsp If (lhDC 0) Then
&nbsp &nbsp &nbsp &nbsp If (bMono) Then
&nbsp &nbsp &nbsp &nbsp &nbsp &nbsp lhBmp = CreateCompatibleBitmap(lhDC, lW, lH)
&nbsp &nbsp &nbsp &nbsp Else
&nbsp &nbsp &nbsp &nbsp &nbsp &nbsp lhBmp = CreateCompatibleBitmap(picThis.hDC, lW, lH)
&nbsp &nbsp &nbsp &nbsp End If
&nbsp &nbsp &nbsp &nbsp If (lhBmp 0) Then
&nbsp &nbsp &nbsp &nbsp &nbsp &nbsp lhBmpOld = SelectObject(lhDC, lhBmp)
&nbsp &nbsp &nbsp &nbsp &nbsp &nbsp CreateDC = True
&nbsp &nbsp &nbsp &nbsp Else
&nbsp &nbsp &nbsp &nbsp &nbsp &nbsp DeleteObject lhDC
&nbsp &nbsp &nbsp &nbsp &nbsp &nbsp lhDC = 0
&nbsp &nbsp &nbsp &nbsp End If
&nbsp &nbsp End If
&nbsp &nbsp
End Function

To test out the function, add a Command button and a Picture Boxes to the project's form. Set the Autoredraw property on the Picture boxe to True. Then paste the code below into the form:

Private Sub Command1_Click()
Static i As Integer
&nbsp &nbsp ReplaceColor Picture1, QBColor(i), &HFFFF&
&nbsp &nbsp i = i + 1
&nbsp &nbsp If (i > 15) Then
&nbsp &nbsp &nbsp &nbsp MsgBox "All colours replaced."
&nbsp &nbsp End If
End Sub

Private Sub Form_Load()
Dim i As Long
Dim x As Long, y As Long, w As Long, h As Long
&nbsp &nbsp
' Draw something in the from picture box.
&nbsp &nbsp ' Alternatively, you could load a picture
&nbsp &nbsp ' into it and set the BackColor to the
&nbsp &nbsp ' colour you want to make transparent.
&nbsp &nbsp Picture1.BackColor = &HFFFF00
&nbsp &nbsp For i = 1 To 200
&nbsp &nbsp &nbsp &nbsp x = Rnd * Picture1.ScaleWidth: y = Rnd * Picture1.ScaleHeight
&nbsp &nbsp &nbsp &nbsp w = Rnd * Picture1.ScaleWidth: h = Rnd * Picture1.ScaleHeight
&nbsp &nbsp &nbsp &nbsp Picture1.Line (x, y)-(x + w, y + h), QBColor(Rnd * 15), BF
&nbsp &nbsp &nbsp &nbsp Picture1.CurrentX = x: Picture1.CurrentY = y
&nbsp &nbsp &nbsp &nbsp Picture1.Print "vbAccelerator Mask Demo"
&nbsp &nbsp Next i
End Sub

During Form_Load, a random pattern of multi coloured squares and text is added. When you click the button, one of the colours will be replaced using the BitBlt method.


Related Tips and Articles:


AboutContributeSend FeedbackPrivacy

Copyright 1998-1999, Steve McMahon ( All Rights Reserved.
Last updated: 09/08/98