Vb6 特绘透明画

有一个图片盒（称为i_MC），我在上面画了一个简单的图像（m_ImgMCN），做：

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

现在我想把一个透明的图像放在这张照片上，在一个特定的位置上。我发现了一个示例代码，它很好地解决了一个问题：第二个（透明）图像不应该透光的部分被纯黑色透光

如果通过设置Picture属性来绘制上面的背景图像，则algo可以完美工作。无法执行此操作，因为这不允许任何拉伸

透明图像是比包含遮罩颜色的框小的简单图像。我使用了以下示例代码（.AutoRedraw=true，适用于所有框和.ScaleMode=3'像素）：

这段代码最初驻留在activevb.de上，我对其进行了一些修改，但没有更改算法或功能。我可能会发布一个原创文章的链接

没有成功，我尝试修改不同中间图片的大小，但它始终绘制错误的图像：

绘制透明图片的图像部分正确，包括背景。图片的其余部分（algo不应触摸）被黑色覆盖

任何想法都值得赞赏。绘制24位字母混合图像的算法也可以！我在谷歌上搜索了很长时间，没有找到一段有效的代码

注：这是一个普通的老VB6，移动到.NET或任何其他语言是不幸的选择

---

提前感谢并致以最良好的问候。我的一个朋友给了我使用WinAPI中的-函数的技巧。现在效果很好。感谢那些看过它的人

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