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相同