Public Class frmFader
 
 
    Dim pic_size As New Size(1920, 1080)
 
    Dim bmp1, bmp2 As Bitmap
 
    Dim pb As New PictureBox With {.Parent = Me, 
        .Size = New Drawing.Size(400, 400),
        .Top = 10, .Left = 10, 
        .SizeMode = PictureBoxSizeMode.Zoom}
 
    Dim WithEvents tm As New Timer With {.Interval = 500, .Enabled = False}
 
 
    Private Sub frmFader_Load(sender As Object, e As EventArgs) Handles _
      MyBase.Load
 
 
        Dim r1 As Rectangle = GetPicRect("G:\daten\x1.jpg", pic_size)
        Dim r2 As Rectangle = GetPicRect("G:\daten\x2.jpg", pic_size)
 
        If Math.Abs(r1.Width - r2.Width) < 3 And 
            Math.Abs(r1.Height - r2.Height) < 3 Then
            r2 = r1
        End If
 
        bmp1 = DrawPic("G:\daten\x1.jpg", pic_size, r1)
        bmp2 = DrawPic("G:\daten\x2.jpg", pic_size, r2)
 
        tm.Enabled = True
    End Sub
 
 
    Private Function GetPicRect(filename As String, picsize As Size) As _
      Rectangle
        Dim w, h, l, t As Integer
        Using bmp As New Bitmap(filename)
            'erforderliche Bildgröße berechnen (Zoomen)
 
            w = CInt(bmp.Width * picsize.Height / bmp.Height)
            h = picsize.Height
            If w > picsize.Width Then
                h = CInt(bmp.Height * picsize.Width / bmp.Width)
                w = picsize.Width
            End If
            'Bild zentrieren
            l = (picsize.Width - w) \ 2
            t = (pic_size.Height - h) \ 2
        End Using
 
        Return New Rectangle(l, t, w, h)
    End Function
 
 
    Private Function DrawPic(filename As String, picsize As Size, 
        picrect As Rectangle) As Bitmap
 
        Dim bmpout As New Bitmap(picsize.Width, pic_size.Height)
 
        Using bmp As New Bitmap(filename)
            'Ausgabebitmap
 
            'Geladenes Bild in erforderlicher Größe neu zeichnen
            Using gout As Graphics = Graphics.FromImage(bmpout)
                gout.InterpolationMode =
                    Drawing2D.InterpolationMode.HighQualityBicubic
                gout.Clear(Color.LightGray)
                gout.DrawImage(bmp,
                            picrect,
                            New Rectangle(0, 0, bmp.Width, bmp.Height),
                            GraphicsUnit.Pixel)
            End Using
        End Using
        Return bmpout
    End Function
 
 
    Private Sub Fade(ByVal Alpha As Single)
        Dim ColMat As New System.Drawing.Imaging.ColorMatrix _
        With {.Matrix33 = Alpha}            ' 
 
        Using bmp As New Bitmap(pic_size.Width, pic_size.Height),
                g As Graphics = Graphics.FromImage(bmp),
                imgAtt As New System.Drawing.Imaging.ImageAttributes
 
            imgAtt.SetColorMatrix(ColMat)
 
            ' Bild deckend in Buffer zeichnen
            g.DrawImage(bmp1, 0, 0)
            ' neues Bild transparent
            ' in Buffer zeichnen
            Dim r As New Rectangle(0, 0, pic_size.Width, pic_size.Height)
            g.DrawImage(bmp2, r, 0, 0, pic_size.Width, pic_size.Height,
                        GraphicsUnit.Pixel, imgAtt)
 
            If pb.Image IsNot Nothing Then pb.Image.Dispose()
            pb.Image = DirectCast(bmp.Clone, Bitmap)
        End Using
 
    End Sub
 
 
    Private Sub tm_Tick(sender As Object, e As EventArgs) Handles tm.Tick
 
        Static alpha As Single = 0
        alpha += CSng(0.1)
        If alpha > 1 Then alpha = 0
        Fade(alpha)
    End Sub
 
End Class