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)
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
注：本站部分文章源于互联网，版权归原作者所有！如有侵权，请原作者与本站联系，本站将立即删除！ 本站文章除特别注明外均可转载，但需注明出处！ [MinTao学以致用网] 
