【CBM666 图片透明淡进溶合共享】
'仅供对图像处理有兴趣的朋友相互交流
'Picture1是背景图 Picture2是那只背景为蓝色的鸟,Picture3是与Picture2相同尺寸的空图片框 再添加 Timer1做淡进用
'Picture3是先将Picture2欲放在Picture1里的区块图当成背景图,再将Picture2屏蔽掉蓝色后的图溶合在Picture3
'最后再将Picture3以淡进的方式显示在Picture1
'如果不考虑要将Picture2屏蔽掉透明色的话,就不需要Picture3了, 直接Picture2与Picture1以淡进方式溶合即可.
'本代码你可以学习到如何截取Picture1里面部份的区块图, 也可学到如何将两张图以不同的透明度来溶合成一张图片
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 GdiTransparentBlt Lib "gdi32" (ByVal hdc1 As Long, ByVal X1 As Long, ByVal Y1 As Long, ByVal W1 As Long, ByVal H1 As Long, ByVal Hdc2 As Long, ByVal X2 As Long, ByVal Y2 As Long, ByVal W2 As Long, ByVal H2 As Long, ByVal Color As Long) As Long
Private Declare Function AlphaBlend Lib "msimg32" (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 widthSrc As Long, ByVal heightSrc As Long, ByVal blendFunct As Long) As Boolean
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)
Private Type rBlendProps
tBlendOp As Byte
tBlendOptions As Byte
tBlendAmount As Byte
tAlphaType As Byte
End Type
Dim NowLevel&, Fadeio%, TransColor&, W&, H&, OldX&, OldY&
Private Sub Form_Load()
Timer1.Enabled = False: TransColor = vbBlue: Picture2.BackColor = TransColor
Me.Move (Screen.Width - Me.Width) \ 2, (Screen.Height - Me.Height) \ 2
Picture1.BorderStyle = 0: Picture2.BorderStyle = 0: Picture3.BorderStyle = 0
Picture1.AutoRedraw = True: Picture2.AutoRedraw = True: Picture3.AutoRedraw = True
Picture2.Move Screen.Width: Picture3.Move Screen.Width
End Sub
Private Sub Command1_Click()
W = Picture2.Width: H = Picture2.Height
OldX = (Picture1.Width - W) \ 2 \ 15: OldY = (Picture1.Height - H) \ 2 \ 15
BitBlt Picture3.hDC, 0, 0, Picture3.Width \ 15, Picture3.Height \ 15, Picture1.hDC, OldX, OldY, vbSrcCopy '将桌面图象绘制到窗体
GdiTransparentBlt Picture3.hDC, 0, 0, W \ 15, H \ 15, Picture2.hDC, 0, 0, W \ 15, H \ 15, TransColor
NowLevel = 0: Timer1.Enabled = True: Timer1.Interval = 100
End Sub
Private Sub Timer1_Timer()
On Error Resume Next
NowLevel = IIf(NowLevel + 10 >= 130, 130, NowLevel + 10)
If NowLevel = 130 Then Timer1.Enabled = False
ShowMixerPic Picture3, Picture1, NowLevel
End Sub
Sub ShowMixerPic(cSrc As PictureBox, cDest As PictureBox, ByVal nLevel As Byte)
On Error Resume Next
Dim LrProps As rBlendProps
Dim LnBlendPtr As Long
cDest.Cls
LrProps.tBlendAmount = nLevel
CopyMemory LnBlendPtr, LrProps, 4
With cSrc
AlphaBlend cDest.hDC, OldX, OldY, .ScaleWidth \ 15, .ScaleHeight \ 15, .hDC, 0, 0, .ScaleWidth \ 15, .ScaleHeight \ 15, LnBlendPtr
End With
cDest.Refresh
End Sub
[解决办法]
效果不错……
看来楼主发飙了，于是开始放血（呵呵，开个玩笑了）
[解决办法]
谢谢LZ分享...
[解决办法]
不恰当的使用错误处理语句。
[解决办法]
学习一下，楼主为什么不把图片框的ScaleMode设置为3，那么就不需要/15的转换了。
[解决办法]
效果看起来不错
[解决办法]
代码看不懂
[解决办法]
学习并接分，何乐而不为。
[解决办法]
[解决办法]
这种贴子要占位置。
[解决办法]
支持CBM666.
[解决办法]
接分，效果可以，但是用起来麻烦，谁封装成ctl控件就好了，然后通过几个属性就可以设置图片。
[解决办法]
'这样更清楚点
Declare Function GdiAlphaBlend Lib "gdi32.dll" _
(ByVal hdcDest As Long, _
ByVal nX As Long, _
ByVal nY As Long, _
ByVal nWidth As Long, _
ByVal nHeight As Long, _
ByVal hdcSrc As Long, _
ByVal orgX As Long, _
ByVal orgY As Long, _
ByVal orgWidth As Long, _
ByVal orgHeight As Long, _
ByVal BLENDFUNCT As Long) As Long
dim i as long
i = AlphaLevel * &H10000&
GdiAlphaBlend x,x,x,x,x,x,x,x, i
每天回帖即可获得10分可用分！
[解决办法]
看起来不错
[解决办法]
[解决办法]
感谢分享
[解决办法]
thanks for sharing
[解决办法]
[解决办法]
该回复于2010-12-03 13:45:33被版主删除
[解决办法]
学习！！！！学习！！！！
[解决办法]
好厉害。。。
[解决办法]
顶！！！！！
[解决办法]
学习～～～
[解决办法]
效果还不错：顶顶!
[解决办法]
CM666老师来CSDN传道咯！！
[解决办法]
good!
[解决办法]
代码看不懂
[解决办法]
[解决办法]
若若的问一下，这是vb语言吧
[解决办法]
该回复于2010-12-01 14:59:03被版主删除
[解决办法]
该回复于2010-12-03 13:48:27被版主删除
[解决办法]
该回复于2010-12-03 13:48:27被版主删除
[解决办法]
从技术角度以及日常遇到这个函数这种使用方法的频率方面来讲，这个帖子不具备推荐价值。
这个是我们CSDN版主的能力认知问题，与楼主无关。
