Expert: Robert Nunemaker - 2/8/2005

Question
-------------------------
Followup To
Question -
Hello there,

I'm just wondering how I can overlap the contents of two picture boxes, but with the top picture having a transparent colour...for example picturebox1 has the letter A with a white background and picturebox2 has the letter B with a blue background...how can I make the blue background in picturebox2 transparent so the A can still be seen behind the B?

Thanking you enormously,

Tom.
Answer -
If you are using VB.NET, it's fairly easy.  If VB6, it's fairly difficult.  For VB6, there are 2 techniques.  1 is to use API's to accomplish it and is fairly involved.  The other is to use a Picture editing program of some kind to set the blue color as the Transparency color.  This will allow the effect you are looking for.


-------------->
I'm using VB6, if you'd rather not go into it, just the API would be handy and I'll work it out from there. Thanks.


Answer
It's rather involved to explain, so here's some code for you to load into a test project.  I can't really take all the credit for it.  I've had it for some time that I got from a friend and have tweaked it from time to time.  You'll have to set the Picture property of the picBackgd control and the picFgd control to your desired pictures (BMP's preferred).  Then, try running it.  You may have to play a little bit with it, but it's pretty neat.

Hope this helps.  Good Luck!

Option Explicit

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
   
'--------------------------------------------------------
' The following APIs are required only when Method 2 is opted
'--------------------------------------------------------
Private Declare Function SetBkColor Lib "gdi32" (ByVal hdc As Long, _
   ByVal crColor As Long) As Long
Private Declare Function GetPixel Lib "gdi32" (ByVal hdc As Long, ByVal x As Long, _
   ByVal y 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 SelectObject Lib "gdi32" (ByVal hdc As Long, _
   ByVal hObject As Long) As Long
Private Declare Function DeleteObject Lib "gdi32" (ByVal hObject 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 DeleteDC Lib "gdi32" (ByVal hdc As Long) As Long

Dim picW As Long
Dim picH As Long
Dim mresult
         
Private Sub Form_Load()
   Me.Move 0, 0
   picBackgd.AutoRedraw = True
   picBackgd.AutoSize = True
   picFgd.AutoRedraw = True
   picFgd.AutoSize = False
   picMask.AutoRedraw = True
   picMask.AutoSize = False
   picProduct.AutoRedraw = True
   picProduct.AutoSize = True
   
     ' For use if Method 1 only
   picReverseMaskedFgd.AutoRedraw = True
   picReverseMaskedFgd.AutoSize = False
   picReversedMask.AutoRedraw = True
   picReversedMask.AutoSize = False
     ' For use if Method 2 only (Not shared, for clarity purposes)
   picUnblockedFgd.AutoRedraw = True
   picUnblockedFgd.AutoSize = False
   picTransparent.AutoRedraw = True
   picTransparent.AutoSize = False
   
   
   picBackgd.Width = picFgd.Width
   picBackgd.Height = picFgd.Height
   picMask.Width = picFgd.Width
   picMask.Height = picFgd.Height
   picProduct.Width = picFgd.Width
   picProduct.Height = picFgd.Height
   
   picReverseMaskedFgd.Height = picFgd.Height
   picReverseMaskedFgd.Width = picFgd.Width
   picReversedMask.Height = picFgd.Height
   picReversedMask.Width = picFgd.Width
   picUnblockedFgd.Width = picFgd.Width
   picUnblockedFgd.Height = picFgd.Height
   picTransparent.Width = picFgd.Width
   picTransparent.Height = picFgd.Height
   
     ' Align
   picFgd.Top = picBackgd.Top
   picProduct.Top = picBackgd.Top
   picUnblockedFgd.Top = picMask.Top
   picReverseMaskedFgd.Top = picMask.Top
   picTransparent.Top = picMask.Top
   picReversedMask.Top = picMask.Top
   picMask.Left = picBackgd.Left
   picUnblockedFgd.Left = picFgd.Left
   picReverseMaskedFgd.Left = picFgd.Left
   picTransparent.Left = picProduct.Left
   picReversedMask.Left = picProduct.Left
   
     ' For convenience
   picW = picBackgd.ScaleWidth
   picH = picBackgd.ScaleHeight
   
     ' Default these first. The following two labels
     ' are shared by Method 1 and 2.
   lblMask.Caption = ""
   lblReverseMaskedFgd.Caption = ""
   lblReversedMask.Caption = ""
   picUnblockedFgd.Visible = False
   picTransparent.Visible = False
End Sub

' To blacken the non-white area
' [Note there is a better alternative: Let Windows to translate a color
' bitmap into a monochrome bitmap when it is copied in memory device
' context. All the nonwhite pixels will come out black.]
Sub CreateMask(inPic As PictureBox, inColorToUse)
   On Error Resume Next
   Dim mTranspColor As Long
   Dim i, j
   
   mTranspColor = inPic.Point(0, 0)
       ' See if existing background is fully covered by
       ' some foreground color which is to serve as
       ' background visually. We are to use image of
       ' picBackgd as the background.
   If mTranspColor <> inColorToUse Then
       For j = 0 To picH + 1
         For i = 0 To picW + 1
         If inPic.Point(j, i) = mTranspColor Then
         inPic.PSet (j, i), vbWhite
         End If
         Next i
         DoEvents
       Next j
   End If
   
   For j = 0 To picH + 1
       For i = 0 To picW + 1
         If inPic.Point(j, i) <> vbWhite Then
         inPic.PSet (j, i), inColorToUse
         End If
       Next i
       DoEvents
   Next j
End Sub

Private Sub cmdMethod1_Click()
   On Error Resume Next
   Me.MousePointer = vbHourglass
   
   picMask.Picture = LoadPicture()
   picUnblockedFgd.Picture = LoadPicture()
   picReverseMaskedFgd.Picture = LoadPicture()
   picReversedMask.Picture = LoadPicture()
   picProduct.Picture = LoadPicture()
   
   lblMask.Caption = "Mask"
   lblReverseMaskedFgd.Caption = "Reverse-masked foreground"
   picReverseMaskedFgd.Visible = True
   picTransparent.Visible = False
   
   lblReversedMask.Caption = "Reversed mask"
   picReversedMask.Visible = True
   picUnblockedFgd.Visible = False
   
       ' (For method 1, we will superimpose on picProduct the
       ' reverse masked foreground, not the picFgd itself, hence
       ' we don't have to call doUnBlockForeGround as we do in
       ' the case of method 2)
       
       ' Prepare picMask (get a replica of foregound image, then mask it)
   mresult = BitBlt(picMask.hdc, 0, 0, picW, picH, _
        picFgd.hdc, 0, 0, vbSrcCopy)
        
    ' Do masking
   CreateMask picMask, vbBlack
   
        ' Background picBackgd can readily be copied onto picProduct
   BitBlt picProduct.hdc, 0, 0, picW, picH, picBackgd.hdc, 0, 0, vbSrcCopy
   picProduct.Picture = picProduct.Image

      ' Copy the mask onto the picProduct using the vbMergePaint opcode
      ' to erase pixels corresponding to black parts of the mask.
   BitBlt picProduct.hdc, 0, 0, picW, picH, picMask.hdc, 0, 0, vbMergePaint
   picProduct.Picture = picProduct.Image

   CreateReverseMaskedFgd
   
      ' Copy the reverse masked Fgd image onto the masked background
   BitBlt picProduct.hdc, 0, 0, picW, picH, picReverseMaskedFgd.hdc, _
         0, 0, vbSrcAnd
   picProduct.Picture = picProduct.Image
   
   Me.MousePointer = vbDefault
End Sub

' For creating reverse-masked foreground as an intermediary
Private Sub CreateReverseMaskedFgd()
      ' Make a reversed mask.
   BitBlt picReversedMask.hdc, 0, 0, picW, picH, picMask.hdc, 0, 0, vbNotSrcCopy
   picReversedMask.Picture = picReversedMask.Image

      ' Copy picFgd to picReverseMaskedFgd
   BitBlt picReverseMaskedFgd.hdc, 0, 0, picW, picH, picFgd.hdc, _
       0, 0, vbSrcCopy
   picReverseMaskedFgd.Picture = picReverseMaskedFgd.Image

      ' Copy the earlier reversed mask onto the picRevserseMaskedFgd
      ' using vbMergePaint opcode to erase part of the foreground
      ' which corresponds to the black parts of that reversed mask.
   BitBlt picReverseMaskedFgd.hdc, 0, 0, picW, picH, picReversedMask.hdc, _
         0, 0, vbMergePaint
   picReverseMaskedFgd.Picture = picReverseMaskedFgd.Image

End Sub

Private Sub cmdMethod2_Click()
   On Error Resume Next
   Me.MousePointer = vbHourglass
   
   picMask.Picture = LoadPicture()
   picUnblockedFgd.Picture = LoadPicture()
   picTransparent.Picture = LoadPicture()
   picProduct.Picture = LoadPicture()
   
   lblMask.Caption = "Mask"
   lblReversedMask.Caption = "Unblocked foreground"
   picUnblockedFgd.Visible = True
   picReversedMask.Visible = False
   
   lblReverseMaskedFgd.Caption = "Transparent bitmap"
   picTransparent.Visible = True
   picReverseMaskedFgd.Visible = False
   
       ' For method 2, we have to check if entire foreground of picFgd
       ' is painted; if so change it, but reflect the change in
       ' picUnblockedFgd only (as after being made transparent it is
       ' this one to be superimposed on picProduct)
       '
       ' Make a copy of picFgd for picUnblockedFgd first
   mresult = BitBlt(picUnblockedFgd.hdc, 0, 0, picW, picH, _
        picFgd.hdc, 0, 0, vbSrcCopy)
   picUnblockedFgd.Picture = picUnblockedFgd.Image
        
       ' Unblock existing background as we are to use a
       ' specified background as per picBackgd.
   doUnBlockForeGround picFgd, picUnblockedFgd
   
       ' Use the unblocked foreground to prepare picMask (get a
       ' replica of foregound image, then mask it).
     ' Make a copy of picUnblockedFgd for its masking
   mresult = BitBlt(picMask.hdc, 0, 0, picW, picH, _
        picUnblockedFgd.hdc, 0, 0, vbSrcCopy)
     ' Do masking
   CreateMask picMask, vbBlack
   
        ' Background picBackgd can readily be copied onto picProduct
   BitBlt picProduct.hdc, 0, 0, picW, picH, picBackgd.hdc, _
         0, 0, vbSrcCopy
   picProduct.Picture = picProduct.Image

      ' Copy the mask onto the picProduct using the vbMergePaint opcode
      ' to erase pixels corresponding to black parts of the mask.
   BitBlt picProduct.hdc, 0, 0, picW, picH, picMask.hdc, 0, 0, vbMergePaint
   picProduct.Picture = picProduct.Image

      ' Continue with other processes
   Dim mColorAsTransparentr As Long
      ' vbWhite as it is that part of area to become transparent in this case
   mColorAsTransparentr = vbWhite
   CreateTransparent picUnblockedFgd, picTransparent, _
         mColorAsTransparentr
         
      ' Put the transparent picFgd on picProduct
   BitBlt picProduct.hdc, 0, 0, picW, picH, picTransparent.hdc, _
         0, 0, vbSrcAnd
   picProduct.Picture = picProduct.Image
   Me.MousePointer = vbDefault
   DoEvents
End Sub

' For creating a transparent bitmap as an intermediary
Sub CreateTransparent(inpicSrc As PictureBox, inpicDest As PictureBox, _
      inTransColor As Long)
   On Error Resume Next
   Dim mMaskDC As Long
   Dim mMaskBmp As Long
   Dim mTempMaskBMP As Long
   Dim mMonoBMP As Long
   Dim mMonoDC As Long
   Dim mTempMonoBMP As Long
   Dim mSrcHDC As Long, mDestHDC As Long
   Dim w As Long, h As Long
   
   w = inpicSrc.ScaleWidth
   h = inpicSrc.ScaleHeight
   
   mSrcHDC = inpicSrc.hdc
   mDestHDC = inpicDest.hdc
   
    ' Set back color of source pic and dest pic to
    ' the desired transparent color
   mresult = SetBkColor&(mSrcHDC, inTransColor)
   mresult = SetBkColor&(mDestHDC, inTransColor)
   
   ' Create a mask DC compatible with dest image
   mMaskDC = CreateCompatibleDC(mDestHDC)
   ' and a bitmap of its size
   mMaskBmp = CreateCompatibleBitmap(mDestHDC, w, h)
   ' Move that bitmap into mMaskDC
   mTempMaskBMP = SelectObject(mMaskDC, mMaskBmp)
   
   ' Meanwhile create another DC for mono bitmap by
   '  setting nPlane and nbitCount both to 1.
   mMonoDC = CreateCompatibleDC(mDestHDC)
   '  and its bitmap, a mono one.
   mMonoBMP = CreateBitmap(w, h, 1, 1, 0)
   mTempMonoBMP = SelectObject(mMonoDC, mMonoBMP)
   
   ' Copy source image to mMonoDC
   mresult = BitBlt(mMonoDC, 0, 0, w, h, mSrcHDC, 0, 0, vbSrcCopy)
       
   ' Copy the mMonoDC into mMaskDC
   mresult = BitBlt(mMaskDC, 0, 0, w, h, mMonoDC, 0, 0, vbSrcCopy)

   'We don't need mMonoBMP any longer
   mMonoBMP = SelectObject(mMonoDC, mTempMonoBMP)
   mresult = DeleteObject(mMonoBMP)
   mresult = DeleteDC(mMonoDC)
   
   'Now copy source image to dest image with XOR
   mresult = BitBlt(mDestHDC, 0, 0, w, h, mSrcHDC, 0, 0, vbSrcInvert)
   
   'Copy the mMaskDC to dest image with AND
   mresult = BitBlt(mDestHDC, 0, 0, w, h, mMaskDC, 0, 0, vbSrcAnd)
   
   'Copy source image to dest image with XOR
   BitBlt mDestHDC, 0, 0, w, h, mSrcHDC, 0, 0, vbSrcInvert
   
   'Picture is there to stay
   inpicDest.Picture = inpicDest.Image
    
   ' We don't need mask DC and bitmap.
   mMaskBmp = SelectObject(mMaskDC, mTempMaskBMP)
   mresult = DeleteObject(mMaskBmp)
   mresult = DeleteDC(mMaskDC)
End Sub

' Called only if Method 2 is deployed.
Private Sub doUnBlockForeGround(inPic1 As PictureBox, inPic2 As PictureBox)
       ' If existing background is fully covered by
       ' some foreground color which only serves as
       ' background visually. We have to change that
       ' since we are to use image of picBackgd as the
       ' background
   Dim mTranspColor, mBackColor
   Dim i, j
   
   mTranspColor = inPic1.Point(0, 0)
   mBackColor = inPic2.BackColor
   If mTranspColor <> vbWhite Then
       For j = 0 To picH + 1
         For i = 0 To picW + 1
         If inPic1.Point(j, i) = mTranspColor Then
         ' We keep inPic1 as it is, but change inPic2
         ' we are to use inPic2 if Method 2 is deployed.
         ' (Thought we may simply replace (j,i) with
         ' vbWhite here in this program, to be effective
         ' in other cases, we use pic2's BackColor)
         inPic2.PSet (j, i), mBackColor
         End If
         Next i
       Next j
   End If
End Sub

Private Sub cmdClear_Click()
   picMask.Cls
   picMask.Picture = LoadPicture()
   picReverseMaskedFgd.Cls
   picReverseMaskedFgd.Picture = LoadPicture()
   picReversedMask.Cls
   picReversedMask.Picture = LoadPicture()
   picProduct.Cls
   picProduct.Picture = LoadPicture()
   picUnblockedFgd.Cls
   picUnblockedFgd.Picture = LoadPicture()
   picTransparent.Cls
   picTransparent.Picture = LoadPicture()
   
   lblMask.Caption = ""
   lblReverseMaskedFgd.Caption = ""
   picReverseMaskedFgd.Visible = True
   picTransparent.Visible = False
   lblReversedMask.Caption = ""
   picReversedMask.Visible = True
   picUnblockedFgd.Visible = False
End Sub

Private Sub cmdExit_Click()
   Unload Me
End Sub