Option Explicit
Public Sub IntervalX(ByVal intI As Integer)If intI > 0 Then Sleep (intI) '制造千分之intI秒的时间间隔End Sub
Public 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, LnBlendPtrEnd Sub
Public 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, SRCCOPY
End Sub
Public Sub ScreenCls()
'刷新桌面 InvalidateRectAsAny 0, ByVal 0&, True
End Sub
Private 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
