slowATthought
Programmer
I need to be able to fade an image to any color in Direct Draw. Any help is.... um.... helpful.
Follow along with the video below to see how to install our site as a web app on your home screen.
Note: This feature may not be available in some browsers.
Option Explicit
Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Private Type BLENDFUNCTION
BlendOp As Byte
BlendFlags As Byte
SourceConstantAlpha As Byte
AlphaFormat As Byte
End Type
' BlendOp:
Private Const AC_SRC_OVER = &H0
' AlphaFormat:
Private Const AC_SRC_ALPHA = &H1
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" ( _
lpvDest As Any, lpvSource As Any, ByVal cbCopy As Long)
Private Declare Function AlphaBlend Lib "MSIMG32.dll" ( _
ByVal hdcDest As Long, _
ByVal nXOriginDest As Long, _
ByVal nYOriginDest As Long, _
ByVal nWidthDest As Long, _
ByVal nHeightDest As Long, _
ByVal hdcSrc As Long, _
ByVal nXOriginSrc As Long, _
ByVal nYOriginSrc As Long, _
ByVal nWidthSrc As Long, _
ByVal nHeightSrc As Long, _
ByVal lBlendFunction As Long _
) As Long
Private Sub Command1_Click()
Dim lBlend As Long
Dim bf As BLENDFUNCTION
Dim alpha As Long
' Draw the first picture:
bf.BlendOp = AC_SRC_OVER
bf.BlendFlags = 0
bf.SourceConstantAlpha = 128
bf.AlphaFormat = 0
CopyMemory lBlend, bf, 4
AlphaBlend Me.hDC, 0, 0, Picture1.ScaleWidth, Picture1.ScaleHeight, Picture1.hDC, 0, 0, Picture1.ScaleWidth, Picture1.ScaleHeight, lBlend
' Make sure picture2 is same size as picture 1
Picture2.Width = Picture1.Width
Picture2.Height = Picture1.Height
' OK now blend towards the colour held in Picture 2
For alpha = 0 To 95
bf.SourceConstantAlpha = alpha
CopyMemory lBlend, bf, 4
AlphaBlend Me.hDC, 0, 0, Picture1.ScaleWidth, Picture1.ScaleHeight, Picture2.hDC, 0, 0, Picture2.ScaleWidth, Picture2.ScaleHeight, lBlend
Sleep 100
Next
End Sub
Private Sub Form_Load()
Form1.Picture = Picture1.Picture
Picture1.AutoSize = True
Picture2.BackColor = RGB(255, 0, 0)
Picture1.AutoRedraw = True
Picture1.ScaleMode = vbPixels
Picture2.ScaleMode = vbPixels
Picture2.AutoRedraw = True
End Sub