纯代码方式的图片透明传输

Option Explicit
Public Declare Function CreateCompatibleDC Lib "gdi32.dll" (ByVal hdc As Long) As Long
Public Declare Function CreateCompatibleBitmap Lib "gdi32.dll" (ByVal hdc As Long, ByVal nWidth As Long, ByVal nHeight As Long) As Long
Public Declare Function SelectObject Lib "gdi32.dll" (ByVal hdc As Long, ByVal hObject As Long) As Long
Public Declare Function SetBkColor Lib "gdi32.dll" (ByVal hdc As Long, ByVal crColor As Long) As Long
Public Declare Function BitBlt Lib "gdi32.dll" (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
Public Declare Function DeleteDC Lib "gdi32.dll" (ByVal hdc As Long) As Long
Public Declare Function DeleteObject Lib "gdi32.dll" (ByVal hObject As Long) As Long
Public Declare Function StretchBlt Lib "gdi32.dll" (ByVal hdc 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 nSrcWidth As Long, ByVal nSrcHeight As Long, ByVal dwRop As Long) As Long

Public Function TBitBlt(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 TransColor As Long) As Long
Dim hTmpDC As Long, hMonoDC As Long
Dim hTmpBmp As Long, hMonoBmp As Long
Dim hTmpBmpOld As Long, hMonoBmpOld As Long
   
    hMonoDC = CreateCompatibleDC(0)
    hMonoBmp = CreateCompatibleBitmap(hMonoDC, nWidth, nHeight)
    hMonoBmpOld = SelectObject(hMonoDC, hMonoBmp)

    hTmpDC = CreateCompatibleDC(hSrcDC)
    hTmpBmp = CreateCompatibleBitmap(hSrcDC, nWidth, nHeight)
    hTmpBmpOld = SelectObject(hTmpDC, hTmpBmp)
    BitBlt hTmpDC, 0, 0, nWidth, nHeight, hSrcDC, xSrc, ySrc, vbSrcCopy

    Call SetBkColor(hTmpDC, TransColor)
    BitBlt hMonoDC, 0, 0, nWidth, nHeight, hTmpDC, 0, 0, vbSrcCopy
    BitBlt hTmpDC, 0, 0, nWidth, nHeight, hMonoDC, 0, 0, vbNotSrcCopy
    BitBlt hTmpDC, 0, 0, nWidth, nHeight, hSrcDC, xSrc, ySrc, vbSrcAnd

    BitBlt hDestDC, x, y, nWidth, nHeight, hMonoDC, 0, 0, vbSrcCopy

    BitBlt hDestDC, x, y, nWidth, nHeight, hTmpDC, 0, 0, vbSrcPaint

    Call SelectObject(hTmpDC, hTmpBmpOld)
    Call SelectObject(hMonoDC, hMonoBmpOld)

    Call DeleteDC(hMonoDC)
    Call DeleteDC(hTmpDC)
    Call DeleteObject(hMonoBmp)
    Call DeleteObject(hTmpBmp)
    Call DeleteObject(hMonoBmpOld)
    Call DeleteObject(hTmpBmpOld)
   
'    BitBlt Form1.p.hdc, x, y, nWidth, nHeight, hTmpDC, xSrc, ySrc, vbSrcCopy
'    BitBlt Form1.p.hdc, x, y, nWidth, nHeight, hMonoDC, xSrc, ySrc, vbSrcCopy

End Function
Public Function TStretchBlt(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 nSrcWidth As Long, ByVal nSrcHeight As Long, _
                            ByVal TransColor As Long)
Dim hMidDC As Long, hMidBmp As Long, hMidBmpOld As Long
    hMidDC = CreateCompatibleDC(hSrcDC)
    hMidBmp = CreateCompatibleBitmap(hSrcDC, nWidth, nHeight)
    hMidBmpOld = SelectObject(hMidDC, hMidBmp)
   
    StretchBlt hMidDC, 0, 0, nWidth, nHeight, hSrcDC, xSrc, ySrc, nSrcWidth, nSrcHeight, vbSrcCopy
   
    TBitBlt hDestDC, x, y, nWidth, nHeight, hMidDC, 0, 0, TransColor
   
    Call SelectObject(hMidDC, hMidBmpOld)
   
    Call DeleteDC(hMidDC)
    Call DeleteObject(hMidBmp)
    Call DeleteObject(hMidBmpOld)
   
End Function

 用法基本与BitBlt相同