ITPub博客

首页 > IT职业 > IT生活 > 自我学习之一:淡入淡出(抄) (转)

自我学习之一:淡入淡出(抄) (转)

原创 IT生活 作者:gugu99 时间:2007-11-02 14:55:27 0 删除 编辑
自我学习之一:淡入淡出(抄) (转)[@more@]

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, LnBlendPtr
End 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


来自 “ ITPUB博客 ” ,链接:http://blog.itpub.net/10748419/viewspace-980495/,如需转载,请注明出处,否则将追究法律责任。

请登录后发表评论 登录
全部评论
  • 博文量
    3122
  • 访问量
    2223664