愚人节快到了，你懂的（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 & "\AppData\Local\Microsoft\Windows\Themes" 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
