扫一扫
分享文章到微信
扫一扫
关注官方公众号
至顶头条
| 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领域最新产品与技术信息,那么订阅至顶网技术邮件将是您的最佳途径之一。