Special-Draw transparent picture

Question

got a PictureBox (called i_MC) and i draw a simple image (m_ImgMCN) on it doing:

Call i_MC.PaintPicture(m_ImgMCN, 0, 0, i_MC.width, i_MC.height)

now i would like to put a transparent image on this picture, on a specific position. i found a sample code, which does the job quite well with one problem: parts of the image that shouldn't be overdrawn with the 2nd (transparent) image are overdrawn with plain black.

the algo works perfectly if the background image from above is drawn by setting the Picture-property. cannot do this because this does not allow any stretching.

the transparent image is a simple image smaller than the box containing a color that is masked. i've used the following sample code (.AutoRedraw=true for all boxes and .ScaleMode=3 'Pixel):

Option Explicit
Private Declare Function BitBlt Lib "gdi32" (ByVal hDCDest As _
        Long, ByVal XDest As Long, ByVal YDest As Long, ByVal _
        nWidth As Long, ByVal nHeight As Long, ByVal hDCSrc _
        As Long, ByVal XSrc As Long, ByVal YSrc As Long, ByVal _
        dwRop 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 SetBkColor Lib "gdi32" (ByVal hdc As _
        Long, ByVal crColor As Long) As Long

Private Declare Function SelectObject Lib "gdi32" (ByVal hdc As _
        Long, ByVal hObject 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 DeleteDC Lib "gdi32" (ByVal hdc As Long) _
        As Long

Private Declare Function DeleteObject Lib "gdi32" (ByVal hObject _
       As Long) As Long

Private Type RECT
  Left As Long
  Top As Long
  Right As Long
  Bottom As Long
End Type
Dim R As RECT

Private Sub TranspPic(OutDstDC&, DstDC&, SrcDC&, SrcRect _
                      As RECT, ByVal DstX&, ByVal DstY&, _
                      TransColor&)

  Dim Result&, W&, H&
  Dim MonoMaskDC&, hMonoMask&, MonoInvDC&, hMonoInv&
  Dim ResultDstDC&, hResultDst&, ResultSrcDC&, hResultSrc&
  Dim hPrevMask&, hPrevInv&, hPrevSrc&, hPrevDst&

    W = SrcRect.Right - SrcRect.Left
    H = SrcRect.Bottom - SrcRect.Top

    'Generieren einer Monochromen & einer inversen Maske
    MonoMaskDC = CreateCompatibleDC(DstDC)
    MonoInvDC = CreateCompatibleDC(DstDC)
    hMonoMask = CreateBitmap(W, H, 1, 1, ByVal 0&)
    hMonoInv = CreateBitmap(W, H, 1, 1, ByVal 0&)
    hPrevMask = SelectObject(MonoMaskDC, hMonoMask)
    hPrevInv = SelectObject(MonoInvDC, hMonoInv)

    'Puffer erstellen
    ResultDstDC = CreateCompatibleDC(DstDC)
    ResultSrcDC = CreateCompatibleDC(DstDC)
    hResultDst = CreateCompatibleBitmap(DstDC, W, H)
    hResultSrc = CreateCompatibleBitmap(DstDC, W, H)
    hPrevDst = SelectObject(ResultDstDC, hResultDst)
    hPrevSrc = SelectObject(ResultSrcDC, hResultSrc)

    'Sourcebild in die monochrome Maske kopieren
    Dim OldBC As Long
    OldBC = SetBkColor(SrcDC, TransColor)
    Result = BitBlt(MonoMaskDC, 0, 0, W, H, SrcDC, _
                  SrcRect.Left, SrcRect.Top, vbSrcCopy)
    TransColor = SetBkColor(SrcDC, OldBC)

    'Inverse Maske erstellen
    Result = BitBlt(MonoInvDC, 0, 0, W, H, _
                  MonoMaskDC, 0, 0, vbNotSrcCopy)

    'Hintergrund des Zielbildes auslesen
    Result = BitBlt(ResultDstDC, 0, 0, W, H, _
                  DstDC, DstX, DstY, vbSrcCopy)

    'AND mit der Maske
    Result = BitBlt(ResultDstDC, 0, 0, W, H, _
                  MonoMaskDC, 0, 0, vbSrcAnd)

    'Überlappung des Sourcebildes mit dem Zielbild auslesen
    Result = BitBlt(ResultSrcDC, 0, 0, W, H, SrcDC, _
                  SrcRect.Left, SrcRect.Top, vbSrcCopy)

    'AND mit der invertierten, monochromen Maske
    Result = BitBlt(ResultSrcDC, 0, 0, W, H, _
                  MonoInvDC, 0, 0, vbSrcAnd)

    'XOR mit beiden
    Result = BitBlt(ResultDstDC, 0, 0, W, H, _
                  ResultSrcDC, 0, 0, vbSrcInvert)

    'Ergebnis in das Zielbild kopieren
    Result = BitBlt(OutDstDC, DstX, DstY, W, H, _
                  ResultDstDC, 0, 0, vbSrcCopy)

    'Erstellte Objekte & DCs wieder freigeben
    hMonoMask = SelectObject(MonoMaskDC, hPrevMask)
    DeleteObject hMonoMask
    DeleteDC MonoMaskDC

    hMonoInv = SelectObject(MonoInvDC, hPrevInv)
    DeleteObject hMonoInv
    DeleteDC MonoInvDC

    hResultDst = SelectObject(ResultDstDC, hPrevDst)
    DeleteObject hResultDst
    DeleteDC ResultDstDC

    hResultSrc = SelectObject(ResultSrcDC, hPrevSrc)
    DeleteObject hResultSrc
    DeleteDC ResultSrcDC
End Sub

Private Sub MovePicTo(ByVal X&, ByVal Y&)
    i_MC.Cls
    picSrc.Picture = m_ImgMCN
    With R
        .Left = 0
        .Top = 0
        .Right = Picture2.ScaleWidth
        .Bottom = Picture2.ScaleHeight
    End With
    Call TranspPic(i_MC.hdc, i_MC.hdc, picSrc.hdc, R, X, Y, vbWhite)
    i_MC.Refresh
    DoEvents
End Sub

this code originally resides on activevb.de, i modified it a little bit without changing the algorithm or functionality. i may post a link to an original article.

without success, I've tried to modify the sizes for the different intermediate pictures, but it keeps painting the image wrong:

the part of the image where the transparent picture is drawn is correct, the background is included. the rest of the picture (which shouldn't be touched by the algo) is overwritten with black.

any idea is appreciated. an algorithm to paint 24-bit alphablended images would be fine as well! I've googled quite long and didn't find a working piece of code.

PS: this is plain old VB6, moving to .NET or any other language is unfortunately not an option.

thanks in advance and best regards

Answer 1

damn. a friend of mine gave me the tip using the TransparentBlt (MSDN)-Function from WinAPI. works now quite well. thanks to those who took a look at it.

ty & gn8

regards atmocreations