| linsoft |
2011-08-29 23:49 |
- 'API
Private Declare Function AlphaBlend Lib "msimg32.dll" (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 BLENDFUNCT As Long) As Long
Private Declare Sub RtlMoveMemory Lib "kernel32.dll" (Destination As Any, Source As Any, ByVal Length As Long)
'常量
Private Const AC_SRC_OVER = &H0
'结构
Private Type BLENDFUNCTION
BlendOp As Byte
BlendFlags As Byte
SourceConstantAlpha As Byte
AlphaFormat As Byte
End Type
'定义新半透明函数
Public Sub TouMing(Outpic As PictureBox, Inpic As PictureBox, x As Long, y As Long, Lv As Single)
Dim BF As BLENDFUNCTION, lBF As Long
If Lv > 1 Or Lv < 0 Then
Exit Sub
End If
With BF
.BlendOp = AC_SRC_OVER
.BlendFlags = 0
.AlphaFormat = 0
.SourceConstantAlpha = 255 * Lv
End With
Outpic.AutoRedraw = True
Inpic.AutoRedraw = True
Outpic.ScaleMode = vbPixels
Inpic.ScaleMode = vbPixels
RtlMoveMemory lBF, BF, 4
AlphaBlend Outpic.hDC, x, y, Inpic.ScaleWidth, Inpic.ScaleHeight, Inpic.hDC, 0, 0, Inpic.ScaleWidth, Inpic.ScaleHeight, lBF
End Sub
把上面的代码放在一个模块里，再在窗体里调用函数TouMing(Outpic As PictureBox, Inpic As PictureBox, x As Long, y As Long, Lv As Single) 。
Outpic 为输出PICTUREBOX控件，Inpic为输入PICTUREBOX控件，X为输出X，Y为输出Y，Lv为透明度（0——1）
代码写的好辛苦，加分！！！！！！！
|
|