Visual Basic Bitmap Routines
CreateCompatibleBitmap: Create a Transparent Bitmap
     
Posted:   Friday December 27, 1996
Updated:   Monday December 26, 2011
     
Applies to:   VB4-32, VB5, VB6
Developed with:   VB4-32, Windows 95
OS restrictions:   None
Author:   Maarten Roode
       
 Prerequisites
None.

vbnstransparent.gif (3222 bytes)Start a new project, and to the form add two controls - a single command button and a single picture box containing the picture to make transparent (Source), as shown in the illustration. The 'Transparent Result' in this example is displayed on the form's hdc, not in another picture or image control.

For the best effect, set the source picture (the one to make transparent) to a bitmap that has various colours on white background.  The Source picture box ScaleMode property should be set to to 3 - Pixel. The colour that will ultimately become the transparent colour is passed as the last parameter in the call to the TransparentBlt routine (vbWhite in this example).
 BAS Module Code
None.

 Form Code
Add a command button (Command1) and a picture box (Picture1) to the form along with the following code:

Option Explicit
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Copyright ©1996-2011 VBnet/Randy Birch, All Rights Reserved.
' Some pages may also contain other copyrights by the author.
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Distribution: You can freely use this code in your own
'               applications, but you may not reproduce 
'               or publish this code on any web site,
'               online service, or distribute as source 
'               on any media without express permission.
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Private Type RECT 
   Left As Long
   Top As Long
   Right As Long
   Bottom As Long
End Type 

Private Declare Function BitBlt Lib "gdi32" _ 
  (ByVal hDCDest As Long, ByVal XDest As Long, _
   ByVal YDest As Long, ByVal nWidth As Long, _
   ByVal nHeight As Long, ByVal hDCSrc As Long, _
   ByVal XSrc As Long, ByVal YSrc As Long, _
   ByVal dwRop As Long) As Long

Private Declare Function CreateBitmap Lib "gdi32" _
  (ByVal nWidth As Long, _
   ByVal nHeight As Long, _
   ByVal nPlanes As Long, _
   ByVal nBitCount As Long, _
   lpBits As Any) As Long

Private Declare Function SetBkColor Lib "gdi32" _
   (ByVal hdc As Long, _
    ByVal crColor As Long) As Long

Private Declare Function SelectObject Lib "gdi32" _
  (ByVal hdc As Long, _
   ByVal hObject As Long) As Long

Private Declare Function CreateCompatibleBitmap Lib "gdi32" _
  (ByVal hdc As Long, _
   ByVal nWidth As Long, _
   ByVal nHeight As Long) As Long

Private Declare Function CreateCompatibleDC Lib "gdi32" _
   (ByVal hdc As Long)As Long

Private Declare Function DeleteDC Lib "gdi32" _
   (ByVal hdc As Long) As Long

Private Declare Function DeleteObject Lib "gdi32" _
   (ByVal hObject As Long) As Long>
   

         
Private Sub Command1_Click()

  Dim rc As RECT

  With rc
   .Left = 0
   .Top = 0
   .Right = Picture1.ScaleWidth
   .Bottom = Picture1.ScaleHeight
  End With

  TransparentBlt Form1.hdc, Form1.hdc, Picture1.hdc, rc, 20, 20, vbWhite

End Sub


Private Sub TransparentBlt(OutDstDC As Long, _
                           DstDC As Long, _
                           SrcDC As Long, _
                           SrcRect As RECT, _
                           DstX As Integer, _
                           DstY As Integer, _
                           TransColor As Long)
   
   'DstDC- Device context into which image must be 
   'drawn transparently
  
   'OutDstDC- Device context into image is actually drawn, 
  'even though it is made transparent in terms of DstDC

   'Src- Device context of source to be made transparent 
   'in color TransColor

   'SrcRect- Rectangular region within SrcDC to be made 
   'transparent in terms of DstDC, and drawn to OutDstDC

   'DstX, DstY - Coordinates in OutDstDC (and DstDC) 
   'where the transparent bitmap must go. In most 
   'cases, OutDstDC and DstDC will be the same 
   Dim nRet As Long, W As Integer, H As Integer
   Dim MonoMaskDC As Long, hMonoMask As Long
   Dim MonoInvDC As Long, hMonoInv As Long
   Dim ResultDstDC As Long, hResultDst As Long
   Dim ResultSrcDC As Long, hResultSrc As Long
   Dim hPrevMask As Long, hPrevInv As Long
   Dim hPrevSrc As Long, hPrevDst As Long
   Dim OldBC As Long
   
   W = SrcRect.Right - SrcRect.Left + 1
   H = SrcRect.Bottom - SrcRect.Top + 1
   
  'create monochrome mask and inverse masks
   MonoMaskDC = CreateCompatibleDC(DstDC)
   MonoInvDC = CreateCompatibleDC(DstDC)
   hMonoMask = CreateBitmap(W, H, 1, 1, ByVal 0&)
   hMonoInv = CreateBitmap(W, H, 1, 1, ByVal 0&)
   hPrevMask = SelectObject(MonoMaskDC, hMonoMask)
   hPrevInv = SelectObject(MonoInvDC, hMonoInv)
   
  'create keeper DCs and bitmaps 
   ResultDstDC = CreateCompatibleDC(DstDC)
   ResultSrcDC = CreateCompatibleDC(DstDC)
   hResultDst = CreateCompatibleBitmap(DstDC, W, H)
   hResultSrc = CreateCompatibleBitmap(DstDC, W, H)
   hPrevDst = SelectObject(ResultDstDC, hResultDst)
   hPrevSrc = SelectObject(ResultSrcDC, hResultSrc)
   
  'copy src to monochrome mask
   OldBC = SetBkColor(SrcDC, TransColor)
   nRet = BitBlt(MonoMaskDC, 0, 0, W, H, SrcDC, _
                 SrcRect.Left, SrcRect.Top, vbSrcCopy)
   TransColor = SetBkColor(SrcDC, OldBC)
   
  'create inverse of mask
   nRet = BitBlt(MonoInvDC, 0, 0, W, H, _
                 MonoMaskDC, 0, 0, vbNotSrcCopy)
   
  'get background
   nRet = BitBlt(ResultDstDC, 0, 0, W, H, _
                 DstDC, DstX, DstY, vbSrcCopy)
   
  'AND with Monochrome mask
   nRet = BitBlt(ResultDstDC, 0, 0, W, H, _
                 MonoMaskDC, 0, 0, vbSrcAnd)
   
  'get overlapper
   nRet = BitBlt(ResultSrcDC, 0, 0, W, H, SrcDC, _
                SrcRect.Left, SrcRect.Top, vbSrcCopy)
   
  'AND with inverse monochrome mask
   nRet = BitBlt(ResultSrcDC, 0, 0, W, H, _
                 MonoInvDC, 0, 0, vbSrcAnd)
   
  'XOR these two
   nRet = BitBlt(ResultDstDC, 0, 0, W, H, _
                 ResultSrcDC, 0, 0, vbSrcInvert)
   
  'output results
   nRet = BitBlt(OutDstDC, DstX, DstY, W, H, _
                 ResultDstDC, 0, 0, vbSrcCopy)
   
  'clean up
   hMonoMask = SelectObject(MonoMaskDC, hPrevMask)
   DeleteObject hMonoMask

   hMonoInv = SelectObject(MonoInvDC, hPrevInv)
   DeleteObject hMonoInv

   hResultDst = SelectObject(ResultDstDC, hPrevDst)
   DeleteObject hResultDst

   hResultSrc = SelectObject(ResultSrcDC, hPrevSrc)
   DeleteObject hResultSrc

   DeleteDC MonoMaskDC
   DeleteDC MonoInvDC
   DeleteDC ResultDstDC
   DeleteDC ResultSrcDC

End Sub
 Comments
Run the project, and press the command button. The bitmap will be copied onto the form, and the white background will appear transparent.

 
 

PayPal Link
Make payments with PayPal - it's fast, free and secure!

 
 
 
 

Copyright ©1996-2011 VBnet and Randy Birch. All Rights Reserved.
Terms of Use  |  Your Privacy

 

 

Hit Counter