'7.8 放置透明图片 可能对你有点用
'in form Command1 Picture1
Option Explicit
Private Sub Command1_Click()
Dim R As RECT
With R
.Left = 0
.Top = 0
.Right = Picture1.ScaleWidth
.Bottom = Picture1.ScaleHeight
End With
TransparentBlt Form1.hdc, Form1.hdc, Picture1.hdc, R, 20, 20, vbWhite
Picture1.Visible = False
End Sub
'in bas
Option Explicit
Public Type RECT
Left As Long
Top As Long
Right As Long
Bottom As Long
End TypePublic 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
Public 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
Public Declare Function SetBkColor Lib "gdi32" _
(ByVal hdc As Long, ByVal crColor As Long) As Long
Public Declare Function SelectObject Lib "gdi32" _
(ByVal hdc As Long, ByVal hObject As Long) As Long
Public Declare Function CreateCompatibleBitmap Lib "gdi32" _
(ByVal hdc As Long, ByVal nWidth As Long, ByVal nHeight As Long) As Long
Public Declare Function CreateCompatibleDC Lib "gdi32" _
(ByVal hdc As Long) As Long
Public Declare Function DeleteDC Lib "gdi32" _
(ByVal hdc As Long) As Long
Public Declare Function DeleteObject Lib "gdi32" _
(ByVal hObject As Long) As LongPublic Sub TransparentBlt(OutDstDC As Long, DstDC As Long, SrcDC As Long, SrcRect As RECT, DstX As Integer, DstY As Integer, TransColor As Long)
'DstDC- Device context into which image must be drawn transparently
'OutDstDC- Device context into image is actually drawn, even though
'it is made transparent in terms of DstDC
'Src- Device context of source to be made transparent in color TransColor 'SrcRect- Rectangular region within SrcDC to be made transparent in terms of
'DstDC, and drawn to OutDstDC
'DstX, DstY - Coordinates in OutDstDC (and DstDC) where the transparent bitmap must go
'In most cases, OutDstDC and DstDC will be the same
Dim nRet As Long, W As Integer, H As Integer
Dim MonoMaskDC As Long, hMonoMask As Long
Dim MonoInvDC As Long, hMonoInv As Long
Dim ResultDstDC As Long, hResultDst As Long
Dim ResultSrcDC As Long, hResultSrc As Long
Dim hPrevMask As Long, hPrevInv As Long
Dim hPrevSrc As Long, hPrevDst As Long
W = SrcRect.Right - SrcRect.Left + 1
H = SrcRect.Bottom - SrcRect.Top + 1
'create monochrome mask and inverse masks
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)
'create keeper DCs and bitmaps
ResultDstDC = CreateCompatibleDC(DstDC)
ResultSrcDC = CreateCompatibleDC(DstDC)
hResultDst = CreateCompatibleBitmap(DstDC, W, H)
hResultSrc = CreateCompatibleBitmap(DstDC, W, H)
hPrevDst = SelectObject(ResultDstDC, hResultDst)
hPrevSrc = SelectObject(ResultSrcDC, hResultSrc)
'copy src to monochrome mask
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)
'create inverse of mask
nRet = BitBlt(MonoInvDC, 0, 0, W, H, MonoMaskDC, 0, 0, vbNotSrcCopy)
'get background
nRet = BitBlt(ResultDstDC, 0, 0, W, H, DstDC, DstX, DstY, vbSrcCopy)
'AND with Monochrome mask
nRet = BitBlt(ResultDstDC, 0, 0, W, H, MonoMaskDC, 0, 0, vbSrcAnd)
'get overlapper
nRet = BitBlt(ResultSrcDC, 0, 0, W, H, SrcDC, SrcRect.Left, SrcRect.Top, vbSrcCopy)
'AND with inverse monochrome mask
nRet = BitBlt(ResultSrcDC, 0, 0, W, H, MonoInvDC, 0, 0, vbSrcAnd)
'XOR these two
nRet = BitBlt(ResultDstDC, 0, 0, W, H, ResultSrcDC, 0, 0, vbSrcInvert)
'output results
nRet = BitBlt(OutDstDC, DstX, DstY, W, H, ResultDstDC, 0, 0, vbSrcCopy)
'clean up
hMonoMask = SelectObject(MonoMaskDC, hPrevMask)
DeleteObject hMonoMask
hMonoInv = SelectObject(MonoInvDC, hPrevInv)
DeleteObject hMonoInv
hResultDst = SelectObject(ResultDstDC, hPrevDst)
DeleteObject hResultDst
hResultSrc = SelectObject(ResultSrcDC, hPrevSrc)
DeleteObject hResultSrc
DeleteDC MonoMaskDC
DeleteDC MonoInvDC
DeleteDC ResultDstDC
DeleteDC ResultSrcDC
End Sub
'in form Command1 Picture1
Option Explicit
Private Sub Command1_Click()
Dim R As RECT
With R
.Left = 0
.Top = 0
.Right = Picture1.ScaleWidth
.Bottom = Picture1.ScaleHeight
End With
TransparentBlt Form1.hdc, Form1.hdc, Picture1.hdc, R, 20, 20, vbWhite
Picture1.Visible = False
End Sub
'in bas
Option Explicit
Public Type RECT
Left As Long
Top As Long
Right As Long
Bottom As Long
End TypePublic 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
Public 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
Public Declare Function SetBkColor Lib "gdi32" _
(ByVal hdc As Long, ByVal crColor As Long) As Long
Public Declare Function SelectObject Lib "gdi32" _
(ByVal hdc As Long, ByVal hObject As Long) As Long
Public Declare Function CreateCompatibleBitmap Lib "gdi32" _
(ByVal hdc As Long, ByVal nWidth As Long, ByVal nHeight As Long) As Long
Public Declare Function CreateCompatibleDC Lib "gdi32" _
(ByVal hdc As Long) As Long
Public Declare Function DeleteDC Lib "gdi32" _
(ByVal hdc As Long) As Long
Public Declare Function DeleteObject Lib "gdi32" _
(ByVal hObject As Long) As LongPublic Sub TransparentBlt(OutDstDC As Long, DstDC As Long, SrcDC As Long, SrcRect As RECT, DstX As Integer, DstY As Integer, TransColor As Long)
'DstDC- Device context into which image must be drawn transparently
'OutDstDC- Device context into image is actually drawn, even though
'it is made transparent in terms of DstDC
'Src- Device context of source to be made transparent in color TransColor 'SrcRect- Rectangular region within SrcDC to be made transparent in terms of
'DstDC, and drawn to OutDstDC
'DstX, DstY - Coordinates in OutDstDC (and DstDC) where the transparent bitmap must go
'In most cases, OutDstDC and DstDC will be the same
Dim nRet As Long, W As Integer, H As Integer
Dim MonoMaskDC As Long, hMonoMask As Long
Dim MonoInvDC As Long, hMonoInv As Long
Dim ResultDstDC As Long, hResultDst As Long
Dim ResultSrcDC As Long, hResultSrc As Long
Dim hPrevMask As Long, hPrevInv As Long
Dim hPrevSrc As Long, hPrevDst As Long
W = SrcRect.Right - SrcRect.Left + 1
H = SrcRect.Bottom - SrcRect.Top + 1
'create monochrome mask and inverse masks
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)
'create keeper DCs and bitmaps
ResultDstDC = CreateCompatibleDC(DstDC)
ResultSrcDC = CreateCompatibleDC(DstDC)
hResultDst = CreateCompatibleBitmap(DstDC, W, H)
hResultSrc = CreateCompatibleBitmap(DstDC, W, H)
hPrevDst = SelectObject(ResultDstDC, hResultDst)
hPrevSrc = SelectObject(ResultSrcDC, hResultSrc)
'copy src to monochrome mask
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)
'create inverse of mask
nRet = BitBlt(MonoInvDC, 0, 0, W, H, MonoMaskDC, 0, 0, vbNotSrcCopy)
'get background
nRet = BitBlt(ResultDstDC, 0, 0, W, H, DstDC, DstX, DstY, vbSrcCopy)
'AND with Monochrome mask
nRet = BitBlt(ResultDstDC, 0, 0, W, H, MonoMaskDC, 0, 0, vbSrcAnd)
'get overlapper
nRet = BitBlt(ResultSrcDC, 0, 0, W, H, SrcDC, SrcRect.Left, SrcRect.Top, vbSrcCopy)
'AND with inverse monochrome mask
nRet = BitBlt(ResultSrcDC, 0, 0, W, H, MonoInvDC, 0, 0, vbSrcAnd)
'XOR these two
nRet = BitBlt(ResultDstDC, 0, 0, W, H, ResultSrcDC, 0, 0, vbSrcInvert)
'output results
nRet = BitBlt(OutDstDC, DstX, DstY, W, H, ResultDstDC, 0, 0, vbSrcCopy)
'clean up
hMonoMask = SelectObject(MonoMaskDC, hPrevMask)
DeleteObject hMonoMask
hMonoInv = SelectObject(MonoInvDC, hPrevInv)
DeleteObject hMonoInv
hResultDst = SelectObject(ResultDstDC, hPrevDst)
DeleteObject hResultDst
hResultSrc = SelectObject(ResultSrcDC, hPrevSrc)
DeleteObject hResultSrc
DeleteDC MonoMaskDC
DeleteDC MonoInvDC
DeleteDC ResultDstDC
DeleteDC ResultSrcDC
End Sub
http://www.21code.com/codebase/?pos=down&id=1423
http://www.21code.com/codebase/?pos=down&id=1421
但愿对你有帮助
而不是把PicTureBox透明!
函数功能:该函数对指定的源设备环境中的矩形区域像素的颜色数据进行位块(bit_block)转换,并将结果置于目标设备环境。函数原型:BOOL TransparentBltm(HDC hdcDest, int nXOriginDest, int nYOriginDest, int nWidthDest, int hHeightDest, HDC hdcSrc, int nXOriginSrc, int nYOriginSrc, int nWidthSrc, int nHeightSrc, UINT crTransparent);参数: hdcDest:指向目标设备环境的句柄。 nXOriginDest:指定目标矩形左上角的X轴坐标,坐标以逻辑单位表示。 nYOriginDest:指定目标矩形左上角的Y轴坐标,坐标以逻辑单位表示。 nWidthDest:指定目标矩形的宽度。 nHeightDest:指定目标矩形高度的句柄。 hdcsrc:指向源设备环境的句柄。 nXOriginSrc:指定源矩形(左上角)的X轴坐标,坐标以逻辑单位表示。 nYOriginsrc:指定源矩形(左上角)的Y轴坐标,坐标以逻辑单位表示。 nWidthSrc:指定源矩形的宽度。 nHeightSrc:指定源矩形的高度。:源位图中的RGB值当作透明颜色。返回值:如果函数执行成功,那么返回值为TRUE;如果函数执行失败,那么返回值为FALSE。 Windows NT:若想获取更多错误信息,请调用GetLastError函数。备注:函数TransparentBlt支持4位/像素和8位/像素格式的源位图,使用AlphaBlend可以指定带有透明度的32位/像素格式的位图。如果源和目标矩形的大小不一致,那么将对源位图进行拉伸以与目标矩形匹配,当使用SetStretchBltMode函数时,BLACKONWHITE和WHITEONBLACK两种iStretchMode模式将被转换成TransparentBlt函数的COLORONCOLOR模式。目标设备环境指定了用于目标坐标的变换类型,而源设备环境指定了源坐标使用的变换类型。如果源位图或目标位图的宽度或高度是负数,那么TransparentBlt函数也不对位图进行镜像。速查:Windows NT:5.0及以上版本;Windows:98及以上版本;Windows CE:不支持;头文件:wingdi.h:库文件:作为一个资源包含在msimg32.dll中。
http://www.21code.com/codebase/?pos=down&id=1754
http://www.csdn.net/expert/topic/655/655759.xml?temp=.4831354
参与讨论,谢谢大家!!!!