Public Sub AlphaBlend(ByRef dibToBlend As cDib, ByVal atX As Long, ByVal atY As _
  Long, ByVal Visibility As Long, ByVal ExCol As Long)
'does fast alpha blending
'Speed: **
Dim i As Long, j As Long
Dim sB() As Byte, sRB As Long
Dim sBN() As Byte, lSB As Long
Dim bSB() As Byte, bRB As Long      'used for the blended dib
Dim RealX As Long, RealY As Long    'final position of the blended
Dim RealW As Long, RealH As Long    '  pic after checking...
Dim Wid As Long, Hei As Long
Dim FirstPos As Long        'offset to start copying
Dim SourceVis As Long       'source visibility
Dim CurLine As Long, ExtX As Long, ExtY As Long
Dim jPlusLine As Long, iPlusj As Long
 
Wid = bmH.biWidth
Hei = bmH.biHeight
'add some foolproof code to avoid errors
If (Visibility <= 0) Or (Visibility > 100) Or (atX > Wid) Or (atY > _
  Hei) Then Exit Sub
 
'get out linear DIBs
sRB = Me.MapArray(sB)
bRB = dibToBlend.MapArray(bSB)
 
'check that picture is in a printable area
'this is to avoid Out of Bounds errors and to reduce computing time
'check width
If atX + dibToBlend.Width <= Wid Then
    If (dibToBlend.Width \ 2) Mod 2 = 0 Then
        If dibToBlend.Width Mod 2 = 0 Then
            RealW = bRB
        Else
            RealW = bRB - 1
        End If
    Else
        RealW = bRB - 5
    End If
Else
    RealW = (Wid - atX) * 3
End If
'check height
If atY + dibToBlend.Height <= Hei Then
    RealH = dibToBlend.Height
Else
    RealH = Hei - atY
End If
'check Xs
If atX < 0 Then
    RealW = RealW + atX * 3
    RealX = 3
    ExtX = dibToBlend.Width * 3 - RealW
ElseIf atX + dibToBlend.Width >= Wid Then
    RealW = (Wid - atX) * 3 - 3
    RealX = atX * 3
Else
    RealX = atX * 3
End If
'check Ys
If atY < 0 Then
    RealH = RealH + atY
    RealY = 0
ElseIf atY + RealH >= Hei Then
    RealY = atY
    ExtY = (dibToBlend.Height - RealH) * bRB
Else
    RealY = atY
End If
'we set an extra offset, try commenting this line and
'see what happens at the bottom and the left
CurLine = ExtX + ExtY
 
'set up the variables
lSB = UBound(sB) - 2
SourceVis = 100 - Visibility
 
FirstPos = lSB - (RealY * sRB) - (RealH * sRB) + RealX + 3
 
For i = FirstPos To FirstPos + (RealH * sRB) - sRB - bRB Step sRB
 
    For j = 0 To RealW Step 3
    jPlusLine = j + CurLine '+ ExtOffset
    iPlusj = i + j
    'check if pixel is transparent
        If RGB(bSB(jPlusLine + 2), bSB(jPlusLine + 1), bSB(jPlusLine)) <> _
          ExCol Then
 
            sB(iPlusj) = (SourceVis * sB(iPlusj) + bSB(jPlusLine) * Visibility) _
              \ 100
            sB(iPlusj + 1) = (SourceVis * sB(iPlusj + 1) + bSB(jPlusLine + 1) * _
            Visibility) \ 100
            sB(iPlusj + 2) = (SourceVis * sB(iPlusj + 2) + bSB(jPlusLine + 2) * _
            Visibility) \ 100
 
        End If
    Next
    CurLine = CurLine + bRB
Next
 
Erase sBN
Me.UnMapArray sB
'VB just loses it's mind if i try to unmap this array
'dibToBlend.UnMapArray bSB
End Sub