Public Type rBlendProps tBlendOp As Byte tBlendOptions As
Byte tBlendAmount As Byte tAlphaType As Byte End
Type
Public 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
Public Declare Sub
CopyMemory Lib "kernel32" Alias "RtlMoveMemory" _ (Destination As Any,
Source As Any, ByVal Length As
Long) 大家可以看到,AlphaBlend函数的定义同普通的复制函数Bitblt很相似,只是最后的参数blendFunct定义为一个rBlendProps结构。那么为什么在函数定义中blendFunct
定义为Long类型呢?因为rBlendProps结构长度是4个字节。
Sub ShowTransparency(cSrc As PictureBox,
cDest As PictureBox, _ ByVal nLevel As Byte) Dim LrProps As
rBlendProps Dim LnBlendPtr As
Long
cDest.Cls LrProps.tBlendAmount = nLevel CopyMemory
LnBlendPtr, LrProps, 4 With cSrc AlphaBlend cDest.hDC, 0, 0,
.ScaleWidth, .ScaleHeight, _ .hDC, 0, 0, .ScaleWidth, .ScaleHeight,
LnBlendPtr End With cDest.Refresh End Sub
Private Sub
Command1_Click() lTime = 0 Timer1.Interval = 100 Timer1.Enabled
= True End Sub
Private Sub Timer1_Timer() lTime = lTime +
1 ShowTransparency Picture2, Picture1, lTime If lTime >= 255
Then Timer1.Enabled = False End If Me.Caption = Str(Int(lTime /
2.55)) + "%" End
Sub 运行程序,点击Command1,就可以看到Picture2图像拷贝到Picture1上的淡入淡出效果了。