Option Explicit
Private Type BlendFunction
BlendOp As Byte
BlendFlags As Byte
SourceConstantAlpha As Byte
AlphaFormat As Byte
End Type
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 BlendFunction As Long) As Long
Private Declare Sub CopyMemory Lib "kernel32.dll" Alias "RtlMoveMemory" ( _
ByRef Destination As Any, _
ByRef Source As Any, _
ByVal Length As Long)
Rem =================================================
Rem == Einblenden des gewünschten Bildes. ==
Rem =================================================
'
Private Sub BlendPicture(ByVal cControl As PictureBox, _
ByVal bBlendFactor As Byte)
Dim bfBlend As BlendFunction
Dim lBlend As Long
Rem =============================================
Rem == Einblendevorgang beginnen. ==
Rem =============================================
bfBlend.SourceConstantAlpha = bBlendFactor
Call CopyMemory(lBlend, bfBlend, 4&)
Call AlphaBlend(cControl.hDC, 0, 0, cControl.ScaleWidth, _
cControl.ScaleHeight, _
Picture2.hDC, 0, 0, Picture2.ScaleWidth, _
Picture2.ScaleHeight, lBlend)
End Sub
Rem =================================================
Rem == Bilder laden, die überlagert werden sollen. ==
Rem =================================================
'
Private Sub Load_Picture(ByVal cControl As PictureBox, _
ByVal szFileName As String)
Dim pTempPicture As IPictureDisp
Set pTempPicture = LoadPicture(szFileName)
cControl.PaintPicture pTempPicture, 0, 0, _
cControl.ScaleWidth, cControl.ScaleHeight
cControl.Picture = cControl.Image
End Sub
Private Sub Command1_Click()
Call Load_Picture(Picture1, "Bild1")
Call Load_Picture(Picture2, "Bild2")
Picture3.Picture = Picture1.Picture
Call BlendPicture(Picture3, 100)
End Sub