VB Code:
Sub TransparentBlt(dsthDC As Long, srchDC As Long, x As Integer, y As Integer, Width As Integer, Height As Integer, TransColor As Long)
Dim maskDC As Long 'DC for the mask
Dim tempDC As Long 'DC for temporary data
Dim hMaskBmp As Long 'Bitmap for mask
Dim hTempBmp As Long 'Bitmap for temporary data
'First, create some DC's. These are our gateways to associated
'bitmaps in RAM
maskDC = CreateCompatibleDC(dsthDC)
tempDC = CreateCompatibleDC(dsthDC)
'Then, we need the bitmaps. Note that we create a monochrome
'bitmap here!
'This is a trick we use for creating a mask fast enough.
hMaskBmp = CreateBitmap(Width, Height, 1, 1, ByVal 0&)
hTempBmp = CreateCompatibleBitmap(dsthDC, Width, Height)
'Then we can assign the bitmaps to the DCs
hMaskBmp = SelectObject(maskDC, hMaskBmp)
hTempBmp = SelectObject(tempDC, hTempBmp)
'Now we can create a mask. First, we set the background color
'to the transparent color; then we copy the image into the
'monochrome bitmap.
'When we are done, we reset the background color of the
'original source.
TransColor = SetBkColor(srchDC, TransColor)
BitBlt maskDC, 0, 0, Width, Height, srchDC, 0, 0, vbSrcCopy
TransColor = SetBkColor(srchDC, TransColor)
'The first we do with the mask is to MergePaint it into the
'destination.
'This will punch a WHITE hole in the background exactly were
'we want the graphics to be painted in.
BitBlt tempDC, 0, 0, Width, Height, maskDC, 0, 0, vbSrcCopy
BitBlt dsthDC, x, y, Width, Height, tempDC, 0, 0, vbMergePaint
'Now we delete the transparent part of our source image. To do
'this, we must invert the mask and MergePaint it into the
'source image. The transparent area will now appear as WHITE.
BitBlt maskDC, 0, 0, Width, Height, maskDC, 0, 0, vbNotSrcCopy
BitBlt tempDC, 0, 0, Width, Height, srchDC, 0, 0, vbSrcCopy
BitBlt tempDC, 0, 0, Width, Height, maskDC, 0, 0, vbMergePaint
'Both target and source are clean. All we have to do is to AND
'them together!
BitBlt dsthDC, x, y, Width, Height, tempDC, 0, 0, vbSrcAnd
'Now all we have to do is to clean up after us and free system
'resources..
DeleteObject (hMaskBmp)
DeleteObject (hTempBmp)
DeleteDC (maskDC)
DeleteDC (tempDC)
End Sub
VB Code:
Private Sub Timer_Timer()
On Error GoTo errhandle
Dim i As Byte
Me.Cls
BitBlt Me.hdc, 0, 0, Me.Width, Me.Height, DesktopDC, 0, 0, vbSrcCopy
If SpriteCount > 0 Then
For i = 1 To SpriteCount
If Sprite(i).Shown Then
With Sprite(i)
picCurrentSprite.Cls
If .Reversed Then StretchBlt picCurrentSprite.hdc, .Width - 1, 0, -.Width, .Height, .hDCofRefPic, .xSrc, .ySrc, .Width, .Height, vbSrcCopy
If Not .Reversed Then BitBlt picCurrentSprite.hdc, 0, 0, .Width, .Height, .hDCofRefPic, .xSrc, .ySrc, vbSrcCopy
TransparentBlt Me.hdc, picCurrentSprite.hdc, .Left, .Top, .Width, .Height, GetPixel(.hDCofRefPic, 1, 1)
If .Reversed Then .Left = .Left + .WalkSpeed
If Not .Reversed Then .Left = .Left - .WalkSpeed
.ySrc = .ySrc + .Height
If .ySrc >= .TotalHeight Then .ySrc = 0
If .Left + .Width < 0 Then .Shown = False
If .Left > (Screen.Width / Screen.TwipsPerPixelX) Then .Shown = False
End With
End If
Next i
End If
Exit Sub
errhandle:
Debug.Print Err.Description
End
End Sub