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

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


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 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" ( _
&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
' 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( _
&nbsp &nbsp &nbsp &nbsp ByRef picFrom As PictureBox, _
&nbsp &nbsp &nbsp &nbsp ByRef picTo As PictureBox, _
&nbsp &nbsp &nbsp &nbsp Optional ByVal lTransparentColor As Long = -1 _
&nbsp &nbsp ) As Boolean
Dim lhDC As Long
Dim lhBmp As Long
Dim lhBmpOld As Long

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

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


Related Tips and Articles:


AboutContributeSend FeedbackPrivacy

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