Option ExplicitPublic Sub IntervalX(ByVal intI As Integer)
If intI > 0 Then Sleep (intI) '制造千分之intI秒的时间间隔
End SubPublic Sub ShowTransparency(SrcDC As Long, _
ByVal SrcX As Long, _
ByVal SrcY As Long, _
ByVal SrcHeight As Long, _
ByVal SrcWidth As Long, _
DestDC As Long, _
ByVal DestX, _
ByVal DestY, _
ByVal DestHeight As Long, _
ByVal DestWidth As Long, _
ByVal nLevel As Byte)
Dim LrProps As rBlendProps
Dim LnBlendPtr As Long LrProps.tBlendAmount = nLevel
CopyMemory LnBlendPtr, LrProps, 4
AlphaBlend DestDC, DestX, DestY, DestWidth, DestHeight, _
SrcDC, SrcX, SrcY, SrcWidth, SrcHeight, LnBlendPtr
End SubPublic Sub CopyPictureX(ByVal dcSour As Long, _
ByVal SourX As Long, _
ByVal SourY As Long, _
ByVal dcDest As Long, _
ByVal DestX As Long, _
ByVal DestY As Long, _
ByVal DestWidth As Long, _
ByVal DestHeight As Long)
'dcSour——>dcDest BitBlt dcDest, DestX, DestY, DestWidth, DestHeight, dcSour, SourX, SourY, SRCCOPYEnd SubPublic Sub ScreenCls() '刷新桌面
InvalidateRectAsAny 0, ByVal 0&, TrueEnd SubPrivate Sub Form_Load() Dim i, l, t Picture2.Height = Picture1.Height
Picture2.Width = Picture1.Width l = (Screen.Width / Screen.TwipsPerPixelX - Picture1.ScaleWidth) / 2
t = (Screen.Height / Screen.TwipsPerPixelY - Picture1.ScaleHeight) / 2 CopyPictureX GetDC(0), l, t, Picture2.hdc, 0, 0, Picture2.ScaleWidth, Picture2.Height For i = 0 To 150 Step 7
IntervalX 150 - i
DoEvents
ShowTransparency Picture1.hdc, 0, 0, Picture1.ScaleHeight, _
Picture1.ScaleWidth, GetDC(0), l, t, _
Picture1.ScaleHeight, Picture1.ScaleWidth, i
Next i IntervalX 1000
For i = 0 To 150 Step 7
IntervalX 150 - i
DoEvents
ShowTransparency Picture2.hdc, 0, 0, Picture2.ScaleHeight, _
Picture2.ScaleWidth, GetDC(0), l, t, _
Picture2.ScaleHeight, Picture2.ScaleWidth, i
Next i ScreenCls Unload Me
End Sub'API声明没写,可以自己填上,你要得是这样的东西吗?
If intI > 0 Then Sleep (intI) '制造千分之intI秒的时间间隔
End SubPublic Sub ShowTransparency(SrcDC As Long, _
ByVal SrcX As Long, _
ByVal SrcY As Long, _
ByVal SrcHeight As Long, _
ByVal SrcWidth As Long, _
DestDC As Long, _
ByVal DestX, _
ByVal DestY, _
ByVal DestHeight As Long, _
ByVal DestWidth As Long, _
ByVal nLevel As Byte)
Dim LrProps As rBlendProps
Dim LnBlendPtr As Long LrProps.tBlendAmount = nLevel
CopyMemory LnBlendPtr, LrProps, 4
AlphaBlend DestDC, DestX, DestY, DestWidth, DestHeight, _
SrcDC, SrcX, SrcY, SrcWidth, SrcHeight, LnBlendPtr
End SubPublic Sub CopyPictureX(ByVal dcSour As Long, _
ByVal SourX As Long, _
ByVal SourY As Long, _
ByVal dcDest As Long, _
ByVal DestX As Long, _
ByVal DestY As Long, _
ByVal DestWidth As Long, _
ByVal DestHeight As Long)
'dcSour——>dcDest BitBlt dcDest, DestX, DestY, DestWidth, DestHeight, dcSour, SourX, SourY, SRCCOPYEnd SubPublic Sub ScreenCls() '刷新桌面
InvalidateRectAsAny 0, ByVal 0&, TrueEnd SubPrivate Sub Form_Load() Dim i, l, t Picture2.Height = Picture1.Height
Picture2.Width = Picture1.Width l = (Screen.Width / Screen.TwipsPerPixelX - Picture1.ScaleWidth) / 2
t = (Screen.Height / Screen.TwipsPerPixelY - Picture1.ScaleHeight) / 2 CopyPictureX GetDC(0), l, t, Picture2.hdc, 0, 0, Picture2.ScaleWidth, Picture2.Height For i = 0 To 150 Step 7
IntervalX 150 - i
DoEvents
ShowTransparency Picture1.hdc, 0, 0, Picture1.ScaleHeight, _
Picture1.ScaleWidth, GetDC(0), l, t, _
Picture1.ScaleHeight, Picture1.ScaleWidth, i
Next i IntervalX 1000
For i = 0 To 150 Step 7
IntervalX 150 - i
DoEvents
ShowTransparency Picture2.hdc, 0, 0, Picture2.ScaleHeight, _
Picture2.ScaleWidth, GetDC(0), l, t, _
Picture2.ScaleHeight, Picture2.ScaleWidth, i
Next i ScreenCls Unload Me
End Sub'API声明没写,可以自己填上,你要得是这样的东西吗?
解决方案 »
免费领取超大流量手机卡,每月29元包185G流量+100分钟通话, 中国电信官方发货