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

最新推荐文章于 2022-11-04 14:22:59 发布

IceMe

最新推荐文章于 2022-11-04 14:22:59 发布

阅读量1.4k

点赞数

分类专栏： VB编程文章标签： function

本文链接：https://blog.csdn.net/iceme/article/details/23068

版权

VB编程专栏收录该内容

2 篇文章 0 订阅

订阅专栏

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