愚人节快到了，你懂的（VB.Net）

只需要一个Form，将背景色调成黑色即可，另加三个Timer。

代码如下：

Option Strict On

Imports System.IO
Imports System.Drawing.Drawing2D

Public Class Form1

    Dim WallPapersImages As New List(Of Image)
    Dim PixelCounts As New List(Of String)
    Dim WallPaperImage As Bitmap
    Dim DifferencesInImagesX As New List(Of Integer)
    Dim DifferencesInImagesY As New List(Of Integer)
    Dim DeskTopDifferenceR As New List(Of Integer)
    Dim DeskTopDifferenceG As New List(Of Integer)
    Dim DeskTopDifferenceB As New List(Of Integer)
    Dim WallPaperDifferenceR As New List(Of Integer)
    Dim WallPaperDifferenceG As New List(Of Integer)
    Dim WallPaperDifferenceB As New List(Of Integer)

    Dim DeskTopImage As Bitmap

    Private Sub Form1_Load(sender As Object, e As EventArgs) Handles MyBase.Load
        Me.CenterToScreen()
        Me.DoubleBuffered = True
        Me.FormBorderStyle = Windows.Forms.FormBorderStyle.None
        Me.Size = New Size(Screen.PrimaryScreen.Bounds.Width, Screen.PrimaryScreen.Bounds.Height)
        Me.Top = 0
        Me.Left = 0
        Me.Opacity = 0
        Me.ShowInTaskbar = False
        Timer1.Interval = 5000
        Timer2.Interval = 1
        Timer3.Interval = 1
        Timer1.Start()
    End Sub

    Private Sub Form1_DoubleClick(sender As Object, e As EventArgs) Handles Me.DoubleClick
        Me.Close()
    End Sub

    Dim WallPaperImagesThemes As New List(Of String)
    Dim WallPaperImagesThemesDirectories As New List(Of String)

    Private Sub Timer1_Tick(sender As Object, e As EventArgs) Handles Timer1.Tick
        Dim UserName As String = Environment.UserName
        Dim WallPaperPath As String = "C:Users" & UserName & "AppDataLocalMicrosoftWindowsThemes"
        For Each Item In My.Computer.FileSystem.GetFiles(WallPaperPath)
            WallPaperImagesThemes.Add(Item)
        Next
        Dim WallPaperImages As String = ""
        For Each Item In WallPaperImagesThemes
            If Item.Contains(".theme") Then
                Dim TempWallPaperImages As String = ""
                WallPaperImages = ""
                Dim SR As New StreamReader(Item)
                Do Until SR.EndOfStream
                    TempWallPaperImages = SR.ReadLine
                    If TempWallPaperImages.Contains("Wallpaper=") Then
                        TempWallPaperImages = TempWallPaperImages.Replace("Wallpaper=%SystemRoot%", "C:Windows")
                        Dim x As Integer = TempWallPaperImages.LastIndexOf(""c)
                        TempWallPaperImages = TempWallPaperImages.Remove(x, TempWallPaperImages.Count - x)
                        WallPaperImagesThemesDirectories.Add(TempWallPaperImages)
                        Exit Do
                    End If
                Loop
                SR.Close()
                SR.Dispose()
            End If
        Next
        For Each Item In WallPaperImagesThemesDirectories
            Dim ImageSize As New Size(Screen.PrimaryScreen.Bounds.Width, Screen.PrimaryScreen.Bounds.Height)
            Dim GetFileNames() As String = My.Computer.FileSystem.GetFiles(Item).ToArray
            For Each DirectoryAndFile In GetFileNames
                If DirectoryAndFile.ToUpper.Contains(".JPG") Or DirectoryAndFile.ToUpper.Contains(".PNG") Or DirectoryAndFile.ToUpper.Contains(".BMP") Or DirectoryAndFile.ToUpper.Contains(".TIF") Then ' Or Item.Contains(".Png") Or Item.Contains(".Bmp") Or Item.Contains(".Gif") Or Item.Contains(".Tif") Then
                    WallPapersImages.Add(ResizeImage(Image.FromFile(DirectoryAndFile), ImageSize, False))
                End If
            Next
        Next
        DeskTopImage = New Bitmap(Screen.PrimaryScreen.Bounds.Width, Screen.PrimaryScreen.Bounds.Height)
        Dim DeskTopImageTest As Graphics = Graphics.FromImage(DeskTopImage)
        DeskTopImageTest.CopyFromScreen(0, 0, 0, 0, DeskTopImage.Size)
        Dim BackGroundImageFound As Boolean = False
        Dim Counter As Integer = 0
        Dim ImageToTestR As Integer = 0
        Dim ImageToTestG As Integer = 0
        Dim ImageToTestB As Integer = 0
        Dim DeskTopImageR As Integer = 0
        Dim DeskTopImageG As Integer = 0
        Dim DeskTopImageB As Integer = 0
        Dim WallPaperR As Integer = 0
        Dim WallPaperG As Integer = 0
        Dim WallPaperB As Integer = 0
        Dim FoundMatchingPixels As Integer = 1
        Dim DidNotFindMatchingPixels As Integer = 0
        Dim PixelsCount As Integer = Screen.PrimaryScreen.Bounds.Width * Screen.PrimaryScreen.Bounds.Height
        Dim ImageNumberAndPixelCount As New List(Of String)

        Do Until Counter > WallPapersImages.Count - 1
            Dim ImageToTest As New Bitmap(WallPapersImages(Counter))

            For x = 0 To CInt(Math.Round(ImageToTest.Width / 10))

                ImageToTestR = ImageToTest.GetPixel(x, 0).R
                ImageToTestG = ImageToTest.GetPixel(x, 0).G
                ImageToTestB = ImageToTest.GetPixel(x, 0).B

                DeskTopImageR = DeskTopImage.GetPixel(x, 0).R
                DeskTopImageG = DeskTopImage.GetPixel(x, 0).G
                DeskTopImageB = DeskTopImage.GetPixel(x, 0).B

                If ImageToTestR > DeskTopImageR - 10 AndAlso ImageToTestR < DeskTopImageR + 10 And _
                    ImageToTestG > DeskTopImageG - 10 AndAlso ImageToTestG < DeskTopImageG + 10 And _
                    ImageToTestB > DeskTopImageB - 10 AndAlso ImageToTestB < DeskTopImageB + 10 Then
                    FoundMatchingPixels += 1
                End If

                If x = CInt(Math.Round(ImageToTest.Width / 10)) Then
                    ImageNumberAndPixelCount.Add("Image number = /" & Counter.ToString & "/Found matching pixels = /" & FoundMatchingPixels.ToString)
                    FoundMatchingPixels = 1
                End If
            Next
            Counter += 1
            If Counter > WallPapersImages.Count - 1 Then
                ImageToTest.Dispose()
            End If
        Loop

        ImageToTestR = 0
        ImageToTestG = 0
        ImageToTestB = 0
        DeskTopImageR = 0
        DeskTopImageG = 0
        DeskTopImageB = 0

        Dim GetImageForFormsBackGround As New List(Of Integer)

        For Each Item In ImageNumberAndPixelCount
            Dim ItemSplit() As String = Item.Split("/"c)
            GetImageForFormsBackGround.Add(CInt(ItemSplit(3)))
        Next

        GetImageForFormsBackGround.Sort()

        For Each Item In ImageNumberAndPixelCount
            If Item.Contains(GetImageForFormsBackGround(GetImageForFormsBackGround.Count - 1).ToString) Then
                Dim ItemSplit() As String = Item.Split("/"c)
                WallPaperImage = New Bitmap(WallPapersImages(CInt(ItemSplit(1))))
                Dim DeskTopImageTaskBarA As Graphics = Graphics.FromImage(WallPaperImage)
                DeskTopImageTaskBarA.CopyFromScreen(0, My.Computer.Screen.WorkingArea.Height, 0, My.Computer.Screen.WorkingArea.Height, WallPaperImage.Size) 'Screen.PrimaryScreen.Bounds.Height - (50, WallPaperImage.Size)
            End If
        Next

        Dim ImageToTest1 As New Bitmap(WallPaperImage)

        For x = 0 To ImageToTest1.Width - 1
            For y = 0 To ImageToTest1.Height - (Screen.PrimaryScreen.Bounds.Height - My.Computer.Screen.WorkingArea.Height) - 1

                WallPaperR = ImageToTest1.GetPixel(x, y).R
                WallPaperG = ImageToTest1.GetPixel(x, y).G
                WallPaperB = ImageToTest1.GetPixel(x, y).B

                DeskTopImageR = DeskTopImage.GetPixel(x, y).R
                DeskTopImageG = DeskTopImage.GetPixel(x, y).G
                DeskTopImageB = DeskTopImage.GetPixel(x, y).B

                If WallPaperR > DeskTopImageR - 30 AndAlso WallPaperR < DeskTopImageR + 30 And _
                WallPaperG > DeskTopImageG - 30 AndAlso WallPaperG < DeskTopImageG + 30 And _
                   WallPaperB > DeskTopImageB - 30 AndAlso WallPaperB < DeskTopImageB + 30 Then
                Else
                    DifferencesInImagesX.Add(x)
                    DifferencesInImagesY.Add(y)
                    DeskTopDifferenceR.Add(DeskTopImageR)
                    DeskTopDifferenceG.Add(DeskTopImageG)
                    DeskTopDifferenceB.Add(DeskTopImageB)
                    WallPaperDifferenceR.Add(WallPaperR)
                    WallPaperDifferenceG.Add(WallPaperG)
                    WallPaperDifferenceB.Add(WallPaperB)
                End If
            Next
        Next

        ImageToTest1.Dispose()
        WallPaperR = 0
        WallPaperG = 0
        WallPaperB = 0
        DeskTopImageR = 0
        DeskTopImageG = 0
        DeskTopImageB = 0

        Me.BackgroundImage = DeskTopImage
        Timer1.Stop()
        Me.Opacity = 1
        Timer2.Start()
        Me.BackColor = Color.DodgerBlue

    End Sub

    Dim PixelChannelA As Integer = 255

    Private Sub Timer2_Tick(sender As Object, e As EventArgs) Handles Timer2.Tick

        Dim NewDeskTopImage As New Bitmap(Me.BackgroundImage)

        For i = 0 To DifferencesInImagesX.Count - 1
            NewDeskTopImage.SetPixel(DifferencesInImagesX(i), DifferencesInImagesY(i), Color.FromArgb(PixelChannelA, DeskTopDifferenceR(i), DeskTopDifferenceG(i), DeskTopDifferenceB(i)))
        Next

        Me.BackgroundImage = NewDeskTopImage

        If PixelChannelA = 0 Then
            Timer2.Stop()
            Timer3.Start()
        Else
            If PixelChannelA >= 15 Then
                PixelChannelA -= 10
            Else
                PixelChannelA -= 1
            End If
        End If

    End Sub

    Private Sub Timer3_Tick(sender As Object, e As EventArgs) Handles Timer3.Tick

        Dim NewDeskTopImage As New Bitmap(Me.BackgroundImage)

        For i = 0 To DifferencesInImagesX.Count - 1
            NewDeskTopImage.SetPixel(DifferencesInImagesX(i), DifferencesInImagesY(i), Color.FromArgb(PixelChannelA, WallPaperDifferenceR(i), WallPaperDifferenceG(i), WallPaperDifferenceB(i)))
        Next

        Me.BackgroundImage = NewDeskTopImage

        If PixelChannelA = 255 Then
            Timer3.Stop()
            Me.BackgroundImage = WallPaperImage
        Else
            If PixelChannelA <= 240 Then
                PixelChannelA += 10
            Else
                PixelChannelA += 1
            End If
        End If

    End Sub

    Public Shared Function ResizeImage(ByVal image As Image, ByVal size As Size, Optional ByVal preserveAspectRatio As Boolean = True) As Image
        Dim newWidth As Integer
        Dim newHeight As Integer
        If preserveAspectRatio Then
            Dim originalWidth As Integer = image.Width
            Dim originalHeight As Integer = image.Height
            Dim percentWidth As Single = CSng(size.Width) / CSng(originalWidth)
            Dim percentHeight As Single = CSng(size.Height) / CSng(originalHeight)
            Dim percent As Single = If(percentHeight < percentWidth,
                    percentHeight, percentWidth)
            newWidth = CInt(originalWidth * percent)
            newHeight = CInt(originalHeight * percent)
        Else
            newWidth = size.Width
            newHeight = size.Height
        End If
        Dim newImage As Image = New Bitmap(newWidth, newHeight)
        Using graphicsHandle As Graphics = Graphics.FromImage(newImage)
            graphicsHandle.InterpolationMode = InterpolationMode.HighQualityBicubic
            graphicsHandle.DrawImage(image, 0, 0, newWidth, newHeight)
        End Using
        Return newImage
    End Function

End Class