Create a mask image (all black for the transparent colour otherwise white) from a bitmap

This tip shows you how to create a mask image from a picture. Mask images are useful for emulating transparency, and for replacing colours in images. This comes about because they are black where you want to leave an image unaffected, and white otherwise. Because they are either on or off, you can use boolean operations while copying the mask image elsewhere.

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

' 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 
' Sets the backcolour of a device context: 
Private Declare Function SetBkColor Lib "gdi32" _
    (ByVal hDC As Long, ByVal crColor As Long) As Long 

Public Function CreateMaskImage( _ 
        ByRef picFrom As PictureBox, _ 
        ByRef picTo As PictureBox, _ 
        Optional ByVal lTransparentColor As Long = -1 _ 
    ) As Boolean 
Dim lhDC As Long 
Dim lhBmp As Long 
Dim lhBmpOld As Long 

    
    ' Make picTo the same size as picFrom and clear it: 
    With picTo 
        .Width = picFrom.Width 
        .Height = picFrom.Height 
        .Cls 
    End With 
    
    ' Create a monochrome DC & Bitmap of the 
    ' same size as the source picture: 
    lhDC = CreateCompatibleDC(0) 
    If (lhDC <> 0) Then 
        lhBmp = CreateCompatibleBitmap(lhDC, _
            picFrom.ScaleWidth \ Screen.TwipsPerPixelX, _
            picFrom.ScaleHeight \ Screen.TwipsPerPixelY) 
        If (lhBmp <> 0) Then 
            lhBmpOld = SelectObject(lhDC, lhBmp) 
            
            ' Set the back 'colour' of the monochrome 
            ' DC to the colour we wish to be transparent: 
            If (lTransparentColor = -1) Then lTransparentColor = picFrom.BackColor 
            SetBkColor lhDC, lTransparentColor 
            
            ' Copy from the from picture to the monochrome DC 
            ' to create the mask: 
            BitBlt lhDC, 0, 0, _
                picFrom.ScaleWidth \ Screen.TwipsPerPixelX, 
                picFrom.ScaleHeight \ Screen.TwipsPerPixelY, _
                picFrom.hDC, 0, 0, SRCCOPY 
            
            ' Now put the mask into picTo: 
            BitBlt picTo.hDC, 0, 0, _
                picFrom.ScaleWidth \ Screen.TwipsPerPixelX, _
                picFrom.ScaleHeight \ Screen.TwipsPerPixelY, _
                lhDC, 0, 0, SRCCOPY 
            picTo.Refresh 
            
            ' Clear up the bitmap we used to create 
            ' the mask: 
            SelectObject lhDC, lhBmpOld 
            DeleteObject lhBmp 
        End If 
        ' Clear up the monochrome DC: 
        DeleteObject lhDC 
    End If 
    
    
End Function 

To test out the function, add a Command button and two Picture Boxes to the project's form. Set the Autoredraw property on both Picture boxes to true.

The following code will create a mask image in the second Picture box (Picture2) from the image in Picture1 when you click the Command button:

Private Sub Command1_Click() 
    CreateMaskImage Picture1, Picture2 
End Sub 

Private Sub Form_Load() 
Dim i 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 
    With Picture1.Font 
        .Name = "Arial" 
        .Bold = True 
        .Italic = True 
        .Size = 12 
    End With 
    For i = 1 To 20 
        Picture1.ForeColor = QBColor(i Mod 15) 
        Picture1.Print "vbAccelerator Mask Demo" 
    Next i 
End Sub