扫一扫
分享文章到微信
扫一扫
关注官方公众号
至顶头条
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) |
Dim lTime As Byte 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 |
如果您非常迫切的想了解IT领域最新产品与技术信息,那么订阅至顶网技术邮件将是您的最佳途径之一。