Public Sub pDrawTransparentBitmap(lHDCDest As Long, lBmSource As Long, _
lMaskColor As Long, Optional lDestStartX As Long, _
Optional lDestStartY As Long, Optional lDestWidth As Long, _
Optional lDestHeight As Long, Optional lSrcStartX As Long, _
Optional lSrcStartY As Long, Optional BkGrndHdc As Long)
' Draw a sprite onto a picture. The background of
' the sprite is made transparent so the pictures
' shows through.
Dim lColorRef As Long
Dim lBmAndBack As Long
Dim lBmAndObject As Long
Dim lBmAndMem As Long
Dim lBmSave As Long
Dim lBmBackOld As Long
Dim lBmObjectOld As Long
Dim lBmMemOld As Long
Dim lBmSaveOld As Long
Dim lHDCMem As Long
Dim lHDCBack As Long
Dim lHDCObject As Long
Dim lHDCTemp As Long
Dim lHDCSave As Long
Dim X As Long
Dim Y As Long
Dim udtBitMap As BITMAP
Dim udtSize As POINTAPI
'
' Create a temporary Device Context compatible with
' the destination DC (picturebox's DC).
lHDCTemp = CreateCompatibleDC(lHDCDest)
' Select the sprite's bitmap into the temporary DC.
Call SelectObject(lHDCTemp, lBmSource)
' Store the sprite bitmap's characteristics in
' the udtBitMap.
Call GetObject(lBmSource, Len(udtBitMap), udtBitMap)
' Set the size of the temporary bitmap.
With udtSize
.X = udtBitMap.bmWidth
.Y = udtBitMap.bmHeight
' Use the optionally passed in width and height values.
If lDestWidth <> 0 Then .X = lDestWidth
If lDestHeight <> 0 Then .Y = lDestHeight
X = .X
Y = .Y
End With
' Create some DCs compatible with
' the picture to hold temporary data.
' This creates one pixel by one pixel
lHDCBack = CreateCompatibleDC(lHDCDest)
lHDCObject = CreateCompatibleDC(lHDCDest)
lHDCMem = CreateCompatibleDC(lHDCDest)
lHDCSave = CreateCompatibleDC(lHDCDest)
' Create a bitmap for each DC. DCs are required
' for a number of GDI functions.
' Monochrome bitmaps.
lBmAndBack = CreateBitmap(X, Y, 1&, 1&, 0&)
lBmAndObject = CreateBitmap(X, Y, 1&, 1&, 0&)
' Color Compatible bitmaps.
lBmAndMem = CreateCompatibleBitmap(lHDCDest, X, Y)
lBmSave = CreateCompatibleBitmap(lHDCDest, X, Y)
' Each DC must select a bitmap object to store pixel data.
' Monochrome
lBmBackOld = SelectObject(lHDCBack, lBmAndBack)
lBmObjectOld = SelectObject(lHDCObject, lBmAndObject)
' Color
lBmMemOld = SelectObject(lHDCMem, lBmAndMem)
lBmSaveOld = SelectObject(lHDCSave, lBmSave)
' Set the mapping mode of the temporary (sprite)
' DC to that of the picture's DC. The mapping mode
' defines the unit of measure used to transform
' page-space units into device-space units, and
' also defines the orientation of the device's
' x and y axes.
Call SetMapMode(lHDCTemp, GetMapMode(lHDCDest))
' Save the sprite bitmap that was passed in
' because it will be overwritten.
Call BitBlt(lHDCSave, 0&, 0&, X, Y, lHDCSave, lSrcStartX, lSrcStartY, vbSrcCopy)
' Set the background color of the sprite's DC to
' the color in the sprite that should be transparent.
' Background color of the DC to MaskColor
lColorRef = SetBkColor(lHDCTemp, lMaskColor)
' Create a mask for the sprite by performing a BitBlt from
' the sprite's bitmap to a monochrome bitmap. The result is
' a matrix of 1's and 0's where 0 represents the foreground
' color and 1 represents the the background color.
Call BitBlt(lHDCObject, 0&, 0&, X, Y, lHDCTemp, lSrcStartX, lSrcStartY, vbSrcCopy)
' Set the background color of the sprite's
' DC back to its original color.
Call SetBkColor(lHDCTemp, lColorRef)
' Create the inverse of the mask.
Call BitBlt(lHDCBack, 0&, 0&, X, Y, lHDCObject, 0&, 0&, vbNotSrcCopy)
' Copy the background of the main DC to the destination.
If (BkGrndHdc = 0) Then
Call BitBlt(lHDCMem, 0&, 0&, X, Y, lHDCDest, lDestStartX, lDestStartY, vbSrcCopy)
Else
Call BitBlt(lHDCMem, 0&, 0&, X, Y, BkGrndHdc, lDestStartX, lDestStartY, vbSrcCopy)
End If
' Mask out the places where the bitmap will be placed by AND-ing
' the memory DC with the mask with the 0's where the foreground is.
Call BitBlt(lHDCMem, 0&, 0&, X, Y, lHDCObject, 0&, 0&, vbSrcAnd)
' Mask out the transparent colored pixels on the bitmap. The
' background of the sprite is masked out so only the foreground remains.
' lHDCTemp is the colored sprite. This is AND-ed with the mask
' which has the 1's where the foreground is and 0's where the background is.
Call BitBlt(lHDCTemp, lSrcStartX, lSrcStartY, X, Y, lHDCBack, 0&, 0&, vbSrcAnd)
' Combine the colored foreground of the sprite with the colored
' background image by OR-ing the bitmap in the prior step with
' that from two steps back.
Call BitBlt(lHDCMem, 0&, 0&, X, Y, lHDCTemp, lSrcStartX, lSrcStartY, vbSrcPaint)
' By varying lDestStartX and lDestStartY we can
' place the sprite in a different location on the
' background image (but now the sprite backgroud will be off).
Call BitBlt(lHDCDest, lDestStartX, lDestStartY, X, Y, lHDCMem, 0&, 0&, vbSrcCopy)
'Call BitBlt(lHDCDest, 0, 0, x, y, lHDCMem, 0&, 0&, vbSrcCopy)
' Place the original sprite bitmap back into the bitmap sent here.
Call BitBlt(lHDCTemp, lDestStartX, lDestStartY, X, Y, lHDCSave, 0&, 0&, vbSrcCopy)
' Delete memory bitmaps.
DeleteObject SelectObject(lHDCBack, lBmBackOld)
DeleteObject SelectObject(lHDCObject, lBmObjectOld)
DeleteObject SelectObject(lHDCMem, lBmMemOld)
DeleteObject SelectObject(lHDCSave, lBmSaveOld)
' Delete memory DC's
DeleteDC lHDCMem
DeleteDC lHDCBack
DeleteDC lHDCObject
DeleteDC lHDCSave
DeleteDC lHDCTemp
End Sub
