SUPPERPOSER 2 IMAGES AVEC UN EFFET DE TRANSPARENCE

Private Function Tranparent(ByVal Couleur1 As Long, ByVal Couleur2 As Long) As Long
    Dim r As Long
    Dim v As Long
    Dim b As Long
    b = ((((Couleur2 \ &H10000) And &HFF) * 50) + (((Couleur1 \ &H10000) And &HFF) * 50)) \ 100
    v = ((((Couleur2 \ &H100) And &HFF) * 50) + (((Couleur1 \ &H100) And &HFF) * 50)) \ 100
    r = (((Couleur2 And &HFF) * 50) + ((Couleur1 And &HFF) * 50)) \ 100
    Tranparent = RGB(r, v, b)
End Function
Private Sub Command1_Click()
    Dim x As Long
    Dim y As Long

    For y = 0 To Picture1.ScaleHeight
        For x = 0 To Picture1.ScaleWidth
            Picture3.PSet (x, y), Tranparent(Picture1.Point(x, y), Picture2.Point(x, y))
        Next
        DoEvents
    Next
End Sub

Télécharger le zip