Source Code VB

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
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