Солнце, воздух и вода
не помогут никогда.
Только спирт и онанизм
укрепляют организм.
Онанизм наш лучший друг -
развивает мышцы рук,
уменьшает вес му#ей
и расходы на бля#ей.

Option Explicit

'Здесь находятся функции, переменные и типы, необходимые для прорисовки прозрачного фона
'некоторые переменные закоментированны, так как они уже были описанны в модуле Declare
'условием корректной работы этой функции является то, что PictureBox (PicSkin.hdc) из которого мы берем картинку должен
'быть обязательно AutoRedraw = True иначе при определенных условиях формы и того где мы будем вызывать
'эту функцию (Form_Paint или еще где), может некорректно прорисовываться картинка или вообще не прорисовываться

'Завершением работы программы или контрола после использования функции TransparentBlt должна быть функция ClearTransparent


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

Public Declare Function BitBlt Lib "gdi32" (ByVal hDestDC As Long, ByVal x As Long, ByVal y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hSrcDC 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 nRet As Long, W As Integer, H As Integer
Private MonoMaskDC As Long, hMonoMask As Long
Private MonoInvDC As Long, hMonoInv As Long
Private ResultDstDC As Long, hResultDst As Long
Private ResultSrcDC As Long, hResultSrc As Long
Private hPrevMask As Long, hPrevInv As Long
Private hPrevSrc As Long, hPrevDst As Long

Public Sub TransparentBlt(OutDstDC As Long, DstDC As Long, SrcDC As Long, SrcRect As RECT, DstX As Integer, DstY As Integer, TransColor As Long)
Dim TransColor As Long

    W = SrcRect.Right - SrcRect.Left
    H = SrcRect.Bottom - SrcRect.Top
    
    Call ClearTransparent
    
    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)
    
    ResultDstDC = CreateCompatibleDC(DstDC)
    ResultSrcDC = CreateCompatibleDC(DstDC)
    hResultDst = CreateCompatibleBitmap(DstDC, W, H)
    hResultSrc = CreateCompatibleBitmap(DstDC, W, H)
    hPrevDst = SelectObject(ResultDstDC, hResultDst)
    hPrevSrc = SelectObject(ResultSrcDC, hResultSrc)
    
    Dim OldBC As Long
    OldBC = SetBkColor(SrcDC, TransColor)
    nRet = BitBlt(MonoMaskDC, 0, 0, W, H, SrcDC, SrcRect.Left, SrcRect.Top, vbSrcCopy)
    TransColor = SetBkColor(SrcDC, OldBC)
    
    nRet = BitBlt(MonoInvDC, 0, 0, W, H, MonoMaskDC, 0, 0, vbNotSrcCopy)
    
    nRet = BitBlt(ResultDstDC, 0, 0, W, H, DstDC, DstX, DstY, vbSrcCopy)
    
    nRet = BitBlt(ResultDstDC, 0, 0, W, H, MonoMaskDC, 0, 0, vbSrcAnd)
    
    nRet = BitBlt(ResultSrcDC, 0, 0, W, H, SrcDC, SrcRect.Left, SrcRect.Top, vbSrcCopy)
    
    nRet = BitBlt(ResultSrcDC, 0, 0, W, H, MonoInvDC, 0, 0, vbSrcAnd)
    
    nRet = BitBlt(ResultDstDC, 0, 0, W, H, ResultSrcDC, 0, 0, vbSrcInvert)
    
    nRet = BitBlt(OutDstDC, DstX, DstY, W, H, ResultDstDC, 0, 0, vbSrcCopy)
    
End Sub

Public Sub ClearTransparent()
    hMonoMask = SelectObject(MonoMaskDC, hPrevMask)
    
    eleteObject hMonoMask
    
    hMonoInv = SelectObject(MonoInvDC, hPrevInv)
    eleteObject hMonoInv
    
    hResultDst = SelectObject(ResultDstDC, hPrevDst)
    eleteObject hResultDst
    
    hResultSrc = SelectObject(ResultSrcDC, hPrevSrc)
    eleteObject hResultSrc
    
    eleteObject MonoMaskDC
    eleteObject MonoInvDC
    eleteObject ResultDstDC
    eleteObject ResultSrcDC
End Sub

Option Explicit

Private Declare Function BitBlt Lib "gdi32" (ByVal hDestDC As Long, ByVal x As Long, ByVal y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hSrcDC 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 nRet As Long, W As Integer, H As Integer
Private MonoMaskDC As Long, hMonoMask As Long
Private MonoInvDC As Long, hMonoInv As Long
Private ResultDstDC As Long, hResultDst As Long
Private ResultSrcDC As Long, hResultSrc As Long
Private hPrevMask As Long, hPrevInv As Long
Private hPrevSrc As Long, hPrevDst As Long

Private Sub TransparentBlt(OutDstDC As Long, DstDC As Long, SrcDC As Long, DstX As Integer, DstY As Integer, DstH As Integer, DstW As Integer, TransColor As Long)
'Dim TransColor As Long

    W = DstW
    H = DstH
    
    Call ClearTransparent
    
    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)
    
    ResultDstDC = CreateCompatibleDC(DstDC)
    ResultSrcDC = CreateCompatibleDC(DstDC)
    hResultDst = CreateCompatibleBitmap(DstDC, W, H)
    hResultSrc = CreateCompatibleBitmap(DstDC, W, H)
    hPrevDst = SelectObject(ResultDstDC, hResultDst)
    hPrevSrc = SelectObject(ResultSrcDC, hResultSrc)
    
    Dim OldBC As Long
    OldBC = SetBkColor(SrcDC, TransColor)
    nRet = BitBlt(MonoMaskDC, 0, 0, W, H, SrcDC, DstX, DstY, vbSrcCopy)
    TransColor = SetBkColor(SrcDC, OldBC)
    
    nRet = BitBlt(MonoInvDC, 0, 0, W, H, MonoMaskDC, 0, 0, vbNotSrcCopy)
    
    nRet = BitBlt(ResultDstDC, 0, 0, W, H, DstDC, DstX, DstY, vbSrcCopy)
    
    nRet = BitBlt(ResultDstDC, 0, 0, W, H, MonoMaskDC, 0, 0, vbSrcAnd)
    
    nRet = BitBlt(ResultSrcDC, 0, 0, W, H, SrcDC, DstX, DstY, vbSrcCopy)
    
    nRet = BitBlt(ResultSrcDC, 0, 0, W, H, MonoInvDC, 0, 0, vbSrcAnd)
    
    nRet = BitBlt(ResultDstDC, 0, 0, W, H, ResultSrcDC, 0, 0, vbSrcInvert)
    
    nRet = BitBlt(OutDstDC, DstX, DstY, W, H, ResultDstDC, 0, 0, vbSrcCopy)
    
End Sub

Public Sub ClearTransparent()
    hMonoMask = SelectObject(MonoMaskDC, hPrevMask)
    
    eleteObject hMonoMask
    
    hMonoInv = SelectObject(MonoInvDC, hPrevInv)
    eleteObject hMonoInv
    
    hResultDst = SelectObject(ResultDstDC, hPrevDst)
    eleteObject hResultDst
    
    hResultSrc = SelectObject(ResultSrcDC, hPrevSrc)
    eleteObject hResultSrc
    
    eleteObject MonoMaskDC
    eleteObject MonoInvDC
    eleteObject ResultDstDC
    eleteObject ResultSrcDC
End Sub

Private Sub UserControl_Show()
'Dim r As RECT
Dim clr As Long
clr = Picture1.Point(1, 1)
UserControl.BackColor = clr
  
  Call TransparentBlt(UserControl.hDC, UserControl.hDC, Picture1.hDC, Picture1.Top, Picture1.Left, Picture1.Height, Picture1.Width, clr)
UserControl.Refresh
End Sub