Inside the Glass

The Create method does most of what CPictureGlass does. This is a long function, so we’ll step through it in pieces. But first, here are the private variables used by the Create method and other CPictureGlass methods and properties:

Private cvsDst As Object, hdcDst As Long, clrMask As Long
Private hdcImage As Long, hbmpImage As Long, hbmpImageOld As Long
Private hdcMask As Long, hbmpMask As Long, hbmpMaskOld As Long
Private hdcBack As Long, hbmpBack As Long, hbmpBackOld As Long
Private hdcCache As Long, hbmpCache As Long, hbmpCacheOld As Long
Private fExist As Boolean, fVisible As Boolean
Private xOld As Long, yOld As Long
Private dxSrc As Long, dySrc As Long
Private xLeft As Long, yTop As Long

This list gives you some idea of the complexity we’re going to be dealing with. Notice that the destination canvas cvsDst has type Object. That’s so you can draw on a form, on a PictureBox, or on a UserControl. But late binding imposes a performance penalty that must be minimized in any animation technique. CPictureGlass does this by saving all the useful properties of the destination canvas in variables. You do this in the Create method, which is called only once and is not speed-critical. You don’t want to access late-bound members in the Draw method, which will be called constantly. But this strategy assumes that whatever you save in Create will be unchanged when Draw tries to use it. That’s one of the reasons the Fun ’n Games form isn’t resizable. Keep this in mind when using CPictureGlass in your own programs. You’ll need to call Create again any time important properties of the destination canvas change.

Create starts out by saving data from its arguments and querying the system for additional data:

Sub Create(cvsDstA As Object, picSrc As Picture, clrMaskA As Long, _
           Optional x As Variant, Optional y As Variant)

    ‘ Clean up any old instance before creating a new one
    If fExist Then Destroy
    ‘ Save at module level for use in properties and methods
    clrMask = clrMaskA
    Set cvsDst = cvsDstA
    If picSrc.Type <> vbPicTypeBitmap Then ErrRaise eePictureNotBitmap

    ‘ Catch any errors from canvas that doesn’t have needed properties
    On Error GoTo CreateErrorCanvas
    With cvsDst
        hdcDst = .hDC
        ‘ Get size and position of image in pixels
        dxSrc = .ScaleX(picSrc.Width, vbHimetric, vbPixels)
        dySrc = .ScaleY(picSrc.Height, vbHimetric, vbPixels)
        ‘ Default is the center
        If IsMissing(x) Then x = .ScaleWidth / 2
        If IsMissing(y) Then y = .ScaleHeight / 2
        xLeft = .ScaleX(x, .ScaleMode, vbPixels)
        yTop = .ScaleY(y, .ScaleMode, vbPixels)
    End With
    Dim cPlanes As Long, cPixelBits As Long
    cPlanes = GetDeviceCaps(hdcDst, PLANES)
    cPixelBits = GetDeviceCaps(hdcDst, BITSPIXEL)

The next step is to create a copy of the Picture we’re going to make transparent. We can’t work on the original because we’re going to modify the picture. This is a temporary variable that can be destroyed when we’re finished.

‘ Create memory DC compatible with screen for picture copy
Dim hdcSrc As Long, hdcSrcOld As Long, hbmpSrcOld As Long
hdcSrc = CreateCompatibleDC(0&)
’ Select bitmap into DC
hbmpSrcOld = SelectObject(hdcSrc, picSrc.Handle)

This code first creates a memory DC compatible with the screen. It then selects the bitmap from the picture into the DC. This copy now has the same bits and colors as the picture. But we don’t need the same bits for transparency—we need an inverted copy of them. So we create another memory DC:

‘ Create memory DC for image with inverted background (AND mask)
hdcImage = CreateCompatibleDC(0&)
’ Create color bitmap same as screen
hbmpImage = CreateBitmap(dxSrc, dySrc, cPlanes, cPixelBits, 0&)
hbmpImageOld = SelectObject(hdcImage, hbmpImage)
’ Make copy of picture because we don’t want to modify original
Call BitBlt(hdcImage, 0, 0, dxSrc, dySrc, hdcSrc, 0, 0, vbSrcCopy)

This is the first of four permanent memory DCs that we’ll blit to and from during the animation. In some cases, we could blit directly to the destination, but it’s faster to blit to a memory DC than to a screen DC so we’ll delay modifying the real destination until the last moment.

Before we can invert the background of the image, we have to create the mask:

‘ Create DC for monochrome mask of image (XOR mask)
hdcMask = CreateCompatibleDC(0&)
’ Create bitmap (monochrome by default)
hbmpMask = CreateCompatibleBitmap(hdcMask, dxSrc, dySrc)
’ Select it into DC
hbmpMaskOld = SelectObject(hdcMask, hbmpMask)
’ Set background of source to the mask color
Call SetBkColor(hdcSrc, clrMask)
’ Copy color bitmap to monochrome DC to create mono mask
Call BitBlt(hdcMask, 0, 0, dxSrc, dySrc, hdcSrc, 0, 0, vbSrcCopy)

This is the same technique described earlier in “Creating Masks,” page 404. The clrMask color determines which color will be transparent.

At this point, we’re finished with the picture object and the copy we made of it, so we can throw it away:

‘ We’ve copied and used the source picture, so give it back
Call SelectObject(hdcSrc, hbmpSrcOld)
Call DeleteDC(hdcSrc)

The image DC still contains an exact duplicate of the original picture, but we’re about to throw away the last vestiges of what we started with. A transparent picture has no use for its background color, and, in fact, that background had better be a known color—black. “Blitting Images onto Backgrounds,” page 401, explains why this inversion is necessary.

‘ Invert background of image to create AND Mask
Call SetBkColor(hdcImage, vbBlack)
Call SetTextColor(hdcImage, vbWhite)
Call BitBlt(hdcImage, 0, 0, dxSrc, dySrc, hdcMask, 0, 0, vbSrcAnd)

At this point, the CPictureGlass object contains an XOR mask and an AND mask, just as an icon does—and it will use them in the same way.

Finally we create a DC to save the background and one to draw a temporary picture (but don’t blit anything to them yet) and wrap up with some error
handling:

    ‘ Create memory DCs for old background and cache
    hdcBack = CreateCompatibleDC(0&)
    hbmpBack = CreateBitmap(dxSrc, dySrc, cPlanes, cPixelBits, 0&)
    hbmpBackOld = SelectObject(hdcBack, hbmpBack)
    hdcCache = CreateCompatibleDC(0&)
    hbmpCache = CreateBitmap(dxSrc, dySrc, cPlanes, cPixelBits, 0&)
    hbmpCacheOld = SelectObject(hdcCache, hbmpCache)
    
    ‘ Invalid x and y indicate first move hasn’t occurred
    xOld = -1: yOld = -1
    fExist = True: fVisible = True
    Exit Sub
CreateErrorCanvas:
    ErrRaise eeInvalidCanvas
End Sub