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
    left As Long
    Top As Long
    Right As Long
    Bottom As Long
End Type
' Creates a memory DC
Private Declare Function CreateCompatibleDC Lib "gdi32" ( _
    ByVal hDC As Long _
    ) As Long
' Creates a bitmap in memory:
Private Declare Function CreateCompatibleBitmap Lib "gdi32" ( _
    ByVal hDC As Long, _
    ByVal nWidth As Long, ByVal nHeight As Long _
    ) As Long
' Places a GDI Object into DC, returning the previous one:
Private Declare Function SelectObject Lib "gdi32" _
    (ByVal hDC As Long, ByVal hObject As Long _
    ) As Long
' Deletes a GDI Object:
Private Declare Function DeleteObject Lib "gdi32" _
    (ByVal hObject As Long _
    ) As Long
' Copies Bitmaps from one DC to another, can also perform
' raster operations during the transfer:
Private Declare Function BitBlt Lib "gdi32" ( _
    ByVal hDestDC 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 dwRop As Long _
    ) 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" ( _
    ByVal crColor As Long _
    ) As Long
' Fills a RECT in a DC with a specified brush
Declare Function FillRect Lib "user32" ( _
    ByVal hDC As Long, _
    lpRect As RECT, _
    ByVal hBrush As Long _
    ) As Long
Public Sub ReplaceColor( _
        ByRef picThis As PictureBox, _
        ByVal lFromColour As Long, _
        ByVal lToColor As Long _
    )
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
   
   
' Cache the width & height of the picture:
    lW = picThis.ScaleWidth \ Screen.TwipsPerPixelX
    lH = picThis.ScaleHeight \ Screen.TwipsPerPixelY
   
' Create a Mono DC & Bitmap
    If (CreateDC(picThis, lW, lH, lMaskDC, lMaskBMP, lMaskBMPOLd, True)) Then
       
' Create a DC & Bitmap with the same colour depth
       
' as the picture:
        If (CreateDC(picThis, lW, lH, lCopyDC, lCopyBMP, lCopyBMPOLd)) Then
           
' Make a mask from the picture which is white in the
           
' replace colour area:
            SetBkColor picThis.hDC, lFromColour
            BitBlt lMaskDC, 0, 0, lW, lH, picThis.hDC, 0, 0, SRCCOPY
                       
           
' Fill the colour DC with the colour we want to replace with
            tR.Right = lW: tR.Bottom = lH
            hBr = CreateSolidBrush(lToColor)
            FillRect lCopyDC, tR, hBr
            DeleteObject hBr
           
' Turn the colour DC black except where the mask is white:
            BitBlt lCopyDC, 0, 0, lW, lH, lMaskDC, 0, 0, SRCAND
           
           
' Create an inverted mask, so it is black where the
           
' colour is to be replaced but white otherwise:
            hBr = CreateSolidBrush(&HFFFFFF)
            FillRect lMaskDC, tR, hBr
            DeleteObject hBr
            BitBlt lMaskDC, 0, 0, lW, lH, picThis.hDC, 0, 0, SRCINVERT
           
' AND the inverted mask with the picture. The picture
           
' goes black where the colour is to be replaced, but is
           
' unaffected otherwise.
            SetBkColor picThis.hDC, &HFFFFFF
            BitBlt picThis.hDC, 0, 0, lW, lH, lMaskDC, 0, 0, SRCAND
                       
           
' Finally, OR the coloured item with the picture. Where
           
' the picture is black and the coloured DC isn't,
           
' the colour will be transferred:
            BitBlt picThis.hDC, 0, 0, lW, lH, lCopyDC, 0, 0, SRCPAINT
            picThis.Refresh
           
           
' Clear up the colour DC:
            SelectObject lCopyDC, lCopyBMPOLd
            DeleteObject lCopyBMP
            DeleteObject lCopyDC
           
        End If
       
       
' Clear up the mask DC:
        SelectObject lMaskDC, lMaskBMPOLd
        DeleteObject lMaskBMP
        DeleteObject lMaskDC
    End If
End Sub
Public Function CreateDC( _
        ByRef picThis As PictureBox, _
        ByVal lW As Long, ByVal lH As Long, _
        ByRef lhDC As Long, ByRef lhBmp As Long, ByRef lhBmpOld As Long, _
        Optional ByVal bMono As Boolean = False _
    ) As Boolean
   
    If (bMono) Then
        lhDC = CreateCompatibleDC(0)
    Else
        lhDC = CreateCompatibleDC(picThis.hDC)
    End If
    If (lhDC 0) Then
        If (bMono) Then
            lhBmp = CreateCompatibleBitmap(lhDC, lW, lH)
        Else
            lhBmp = CreateCompatibleBitmap(picThis.hDC, lW, lH)
        End If
        If (lhBmp 0) Then
            lhBmpOld = SelectObject(lhDC, lhBmp)
            CreateDC = True
        Else
            DeleteObject lhDC
            lhDC = 0
        End If
    End If
   
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
    ReplaceColor Picture1, QBColor(i), &HFFFF&
    i = i + 1
    If (i > 15) Then
        MsgBox "All colours replaced."
    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
   
' Draw something in the from picture box.
   
' Alternatively, you could load a picture
   
' into it and set the BackColor to the
   
' colour you want to make transparent.
    Picture1.BackColor = &HFFFF00
    For i = 1 To 200
        x = Rnd * Picture1.ScaleWidth: y = Rnd * Picture1.ScaleHeight
        w = Rnd * Picture1.ScaleWidth: h = Rnd * Picture1.ScaleHeight
        Picture1.Line (x, y)-(x + w, y + h), QBColor(Rnd * 15), BF
        Picture1.CurrentX = x: Picture1.CurrentY = y
        Picture1.Print "vbAccelerator Mask Demo"
    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.
Author: