窗口嵌入桌面背景层（vb.net，高考倒计时特供版）

开发思路

根据系统生成高考倒计时的具体时间，附加江苏省省统考的时间生成算法，并且用户可以根据实际情况调整前后30天，具有丰富多彩的图片库和强大的自定义功能，效果图见P3

目前程序处于正式版的1.4版本，本程序由本作者开发，平台Windows，dotnet-Core8.0，兼容win7、win10、win11，即目前主流的操作系统

实现方式

使用本人开发理念时间距离计算算法和窗口嵌入功能嵌入桌面背景

感谢​​​​​​  wenshitao 

提供的部分代码，GitHub开源项目：（P2）AnimateBackgroundWinform/gui_animate_destop/Util.cs at master · Nakasu-ksm/AnimateBackgroundWinform · GitHub

 农历系统的类库稳定版需要Core版本，所以FrameWork开发者可以尝试将代码移植到Core跨平台上面（P1）

P1：YiJingFramework.Nongli

 P2：快照-2024年9月16日 00点26分截图

 本程序实现效果图：

P3：效果图

 大部分代码MainForm的代码，开源文件会上传CSDN和GitHub百度网盘，详见文章末尾

Class Util：

Imports System
Imports System.Collections.Generic
Imports System.Linq
Imports System.Text
Imports System.Threading.Tasks
Imports System.Windows.Forms
Imports System.Threading
Imports System.Security.PrincipalClass UtilPrivate Shared progmanPtr As IntPtrPrivate Shared sendMessageBack As IntPtrPrivate Shared workWPtr As IntPtrPublic Shared Function IsAdmin() As BooleanDim current As WindowsIdentity = WindowsIdentity.GetCurrent()Dim checkUser As WindowsPrincipal = New WindowsPrincipal(current)Return checkUser.IsInRole(WindowsBuiltInRole.Administrator)End FunctionPublic Sub SetAnimeBackground(ByVal videoPtr As IntPtr)Dim windows_version As Double = Environment.OSVersion.Version.MajorprogmanPtr = FindWindow("Progman", Nothing)If progmanPtr = IntPtr.Zero ThenMessageBox.Show("当前系统可能不支持运行本程序或者卡死")ReturnElseSendMessageTimeout(progmanPtr, &H52C, IntPtr.Zero, IntPtr.Zero, 0, &H3E8, sendMessageBack)EnumWindows(Function(hwnd, param)If Win32.FindWindowEx(hwnd, IntPtr.Zero, "SHELLDLL_DefView", Nothing) <> IntPtr.Zero ThenworkWPtr = Win32.FindWindowEx(IntPtr.Zero, hwnd, "WorkerW", Nothing)If windows_version < 6.2 ThenWin32.ShowWindow(workWPtr, 0)End IfEnd IfReturn TrueEnd Function, 0)If windows_version < 6.2 ThenSetParent(videoPtr, progmanPtr)ElseSetParent(videoPtr, workWPtr)End IfThread.Sleep(500)SetWindowPos(videoPtr, IntPtr.Zero, 0, 0, Win32.GetSystemMetrics(0), Win32.GetSystemMetrics(1), 0)Thread.Sleep(100)'VideoForm.videoForm.Show()End IfEnd Sub
End Class

 Win32：

Imports System
Imports System.Collections.Generic
Imports System.Linq
Imports System.Text
Imports System.Threading.Tasks
Imports Microsoft.Win32
Imports System.Runtime.InteropServicesPublic Module Win32<DllImport("user32.dll")>Public Function FindWindow(ByVal className As String, ByVal winName As String) As IntPtrEnd Function<DllImport("user32.dll")>Public Function SendMessageTimeout(ByVal hwnd As IntPtr, ByVal msg As UInteger, ByVal wParam As IntPtr, ByVal lParam As IntPtr, ByVal fuFlage As UInteger, ByVal timeout As UInteger, ByVal result As IntPtr) As IntPtrEnd Function<DllImport("user32.dll")>Public Function EnumWindows(ByVal proc As EnumWindowsProc, ByVal lParam As Integer) As BooleanEnd FunctionPublic Delegate Function EnumWindowsProc(ByVal hwnd As IntPtr, ByVal lParam As IntPtr) As Boolean<DllImport("user32.dll")>Public Function FindWindowEx(ByVal hwndParent As IntPtr, ByVal hwndChildAfter As IntPtr, ByVal className As String, ByVal winName As String) As IntPtrEnd Function<DllImport("user32.dll")>Public Function ShowWindow(ByVal hwnd As IntPtr, ByVal nCmdShow As Integer) As BooleanEnd Function<DllImport("user32.dll")>Public Function SetParent(ByVal hwnd As IntPtr, ByVal parentHwnd As IntPtr) As IntPtrEnd Function<DllImport("user32.dll", EntryPoint:="GetSystemMetrics")>Public Function GetSystemMetrics(ByVal which As Integer) As IntegerEnd Function<DllImport("gdi32.dll", EntryPoint:="GetDeviceCaps", SetLastError:=True)>Public Function GetDeviceCaps(ByVal hdc As IntPtr, ByVal nIndex As Integer) As IntegerEnd Function<DllImport("user32.dll")>Public Sub SetWindowPos(ByVal hwnd As IntPtr, ByVal hwndInsertAfter As IntPtr, ByVal X As Integer, ByVal Y As Integer, ByVal width As Integer, ByVal height As Integer, ByVal flags As UInteger)End SubEnd Module

MainForm 

Imports System.ComponentModel
Imports System.Drawing.Drawing2D
Imports System.Globalization
Imports System.Runtime.InteropServices
Imports System.Text
Imports YiJingFramework
Imports YiJingFramework.Nongli
Imports YiJingFramework.Nongli.Extensions
Imports YiJingFramework.Nongli.Lunar
Public Class MainFormDim s As StringDim f1, f2 As FontDim t As New TextBoxDim size As Size = Screen.PrimaryScreen.Bounds.SizeDim bmp As New Bitmap(size.Width, size.Height)Dim g As Graphics = Graphics.FromImage(bmp)Dim vis As BooleanDim bmpindex As Integer = -1Dim errcount As IntegerDim mode As IntegerFunction GetNongLi()Dim dateTime = Date.NowDim lunar = LunarDateTime.FromGregorian(dateTime)' ReturnReturn ($"{lunar.Nian:C}年 " + $"{lunar.YueInChinese()}月" + $"{lunar.RiInChinese()}")End FunctionPrivate Sub Form1_Load(sender As Object, e As EventArgs) Handles MyBase.LoadTrys = IO.File.ReadAllText(Application.StartupPath & "\config")t.Text = sIf gl(0) = 1 ThenRadioButton1.Checked = Truemode = 1ElseIf gl(0) = 2 ThenRadioButton2.Checked = Truemode = 2ElseIf gl(0) = 3 ThenRadioButton3.Checked = Truemode = 3End IfTextBox1.Text = gl(1)TextBox2.Text = gl(2)TextBox3.Value = gl(3)Pic1.BackColor = glc(4)Pic2.BackColor = glc(7)Pic3.BackColor = glc(10)f1 = glf(13)f2 = glf(16)Label3.Text = gfinf(f1)Label4.Text = gfinf(f2)ComboBox1.SelectedIndex = gl(19)OffsetDays.Value = CInt(gl(20))Button8.PerformClick()Catch ex As Exceptionvis = TrueMe.Visible = TrueEnd TryEnd SubPrivate Sub Button1_Click(sender As Object, e As EventArgs) Handles Button1.ClickDim dlg As New ColorDialogIf dlg.ShowDialog = DialogResult.OK ThenPic1.BackColor = dlg.ColorEnd IfEnd SubPrivate Sub Button5_Click(sender As Object, e As EventArgs) Handles Button5.ClickDim dlg As New ColorDialogIf dlg.ShowDialog = DialogResult.OK ThenPic2.BackColor = dlg.ColorEnd IfEnd SubPrivate Sub Button4_Click(sender As Object, e As EventArgs) Handles Button4.ClickDim dlg As New ColorDialogIf dlg.ShowDialog = DialogResult.OK ThenPic3.BackColor = dlg.ColorEnd IfEnd SubPrivate Sub Button2_Click(sender As Object, e As EventArgs) Handles Button2.ClickDim dlg As New OpenFileDialogdlg.Filter = "All Picture Files|*.jpg;*.png;*.gif;*.bmp;*.tiff"dlg.Title = "请选择一个图片"If dlg.ShowDialog = DialogResult.OK And IO.File.Exists(dlg.FileName) ThenTextBox1.Text = dlg.FileNameEnd IfEnd SubPrivate Sub Button3_Click(sender As Object, e As EventArgs) Handles Button3.ClickDim dlg As New FolderBrowserDialogIf dlg.ShowDialog = DialogResult.OK ThenTextBox2.Text = dlg.SelectedPathbmpindex = -1End IfEnd SubPrivate Sub Button9_Click(sender As Object, e As EventArgs) Handles Button9.Clicks = ""If RadioButton1.Checked Thena(1)ElseIf RadioButton2.Checked Thena(2)ElseIf RadioButton3.Checked Thena(3)End Ifa(TextBox1.Text)a(TextBox2.Text)a(TextBox3.Text) ''shijian jiangeac(Pic1) ''beijingac(Pic2) ''putong wenziac(Pic3) ''daojishi wenziaf(f1)af(f2)a(ComboBox1.SelectedIndex)a(CInt(OffsetDays.Value))IO.File.WriteAllText(Application.StartupPath & "\config", s)End SubSub a(s As String)Me.s &= s & vbCrLfEnd SubPrivate Sub Button6_Click(sender As Object, e As EventArgs) Handles Button6.ClickDim dlg As New FontDialogdlg.Font = f1If dlg.ShowDialog() = DialogResult.OK Thenf1 = dlg.FontLabel3.Text = gfinf(f1)End IfEnd SubPrivate Sub Button7_Click(sender As Object, e As EventArgs) Handles Button7.ClickDim dlg As New FontDialogdlg.Font = f2If dlg.ShowDialog() = DialogResult.OK Thenf2 = dlg.FontLabel4.Text = gfinf(f2)End IfEnd SubSub ac(pic As PictureBox)a(pic.BackColor.R)a(pic.BackColor.G)a(pic.BackColor.B)End SubSub af(f As Font)a(f.FontFamily.Name)a(f.Size)a(f.Style)End SubFunction gl(i As Integer) As StringReturn t.Lines(i)End FunctionFunction glc(i As Integer) As ColorReturn Color.FromArgb(gl(i), gl(i + 1), gl(i + 2))End FunctionFunction glf(i As Integer) As FontDim stl As FontStyle = gl(i + 2)Return New Font(gl(i), CInt(gl(i + 1)), stl)End Function<DllImport("user32.dll", EntryPoint:="SystemParametersInfo")>Shared Function SystemParametersInfo(uAction As Integer, uParam As Integer, lpvParam As String, fuWinIni As Integer) As IntegerEnd Function' Private Declare Ansi Function SystemParametersInfo Lib "user32" Alias "SystemParametersInfo" (uAction As Integer, uParam As Integer, <MarshalAs(UnmanagedType.VBByRefStr)> ByRef lpvParam As String, fuWinIni As Integer) As IntegerPrivate Sub Button8_Click(sender As Object, e As EventArgs) Handles Button8.Clicksize = Screen.PrimaryScreen.Bounds.Sizebmp = New Bitmap(size.Width, size.Height)g = Graphics.FromImage(bmp)Button9_Click(Nothing, Nothing)Dim d As Date = Date.NowDim y As IntegerDim dg As DateDim textpath As StringIf (d.Date.Month = 6 And d.Date.Day >= 10) Or (d.Date.Month > 6) Theny = d.Date.Year + 1dg = New Date(y, 6, 7)Elsey = d.Date.Yeardg = New Date(y, 6, 7)End Ifg.FillRectangle(New SolidBrush(Pic1.BackColor), Screen.PrimaryScreen.Bounds)Dim bmp1 As BitmapIf mode = 1 ThenGoTo H1ElseIf mode = 2 Thentextpath = TextBox1.TextTrybmp1 = New Bitmap(textpath)Catch ex As ExceptionMsgBox("文件不存在！")Exit SubEnd TryElseIf mode = 3 ThenTryDim interr = 0
H2:             Dim list As ObjectModel.ReadOnlyCollection(Of String) '定义该路径下文件名的集合list = My.Computer.FileSystem.GetFiles(TextBox2.Text)Dim max As Integer = list.Countbmpindex += 1If bmpindex = max Thenbmpindex = 0End Iftextpath = list(bmpindex)Trybmp1 = New Bitmap(textpath)Catch ex As Exceptioninterr += 1If interr = max ThenMsgBox("文件夹下没有图片")Exit SubEnd IfGoTo H2End TryCatch ex As ExceptionMsgBox("文件夹不存在！")Exit SubEnd TryEnd IfSelect Case ComboBox1.SelectedIndexCase 0g.DrawImage(bmp1, New PointF(0, 0))Case 1' g.FillRectangle(New SolidBrush(Pic1.BackColor), Screen.PrimaryScreen.Bounds)If (bmp1.Width / bmp1.Height) < (size.Width / size.Height) ThenDim k As Single = size.Height / bmp1.HeightDim newh = size.HeightDim neww = bmp1.Width * kg.DrawImage(bmp1, New Rectangle((size.Width - neww) / 2, 0, neww, newh), New Rectangle(0, 0, bmp1.Width, bmp1.Height), GraphicsUnit.Pixel)ElseDim k As Single = size.Width / bmp1.WidthDim newh = bmp1.Height * kDim neww = size.Widthg.DrawImage(bmp1, New Rectangle(0, (size.Height - newh) / 2, neww, newh), New Rectangle(0, 0, bmp1.Width, bmp1.Height), GraphicsUnit.Pixel)End IfCase 2g.DrawImage(bmp1, New Rectangle(New Point(0, 0), size), New Rectangle(0, 0, bmp1.Width, bmp1.Height), GraphicsUnit.Pixel)Case 3If (bmp1.Width / bmp1.Height) > (size.Width / size.Height) ThenDim k As Single = size.Height / bmp1.HeightDim newh = size.HeightDim neww = bmp1.Width * kg.DrawImage(bmp1, New Rectangle((size.Width - neww) / 2, 0, neww, newh), New Rectangle(0, 0, bmp1.Width, bmp1.Height), GraphicsUnit.Pixel)ElseDim k As Single = size.Width / bmp1.WidthDim newh = bmp1.Height * kDim neww = size.Widthg.DrawImage(bmp1, New Rectangle(0, (size.Height - newh) / 2, neww, newh), New Rectangle(0, 0, bmp1.Width, bmp1.Height), GraphicsUnit.Pixel)End IfEnd SelectH1:     g.SmoothingMode = SmoothingMode.HighQuality' Dim strsize As Size = If d.Date.Month = 6 And (d.Date.Day = 7 Or d.Date.Day = 8 Or d.Date.Day = 9) ThenDim p1 As Point = New Point((size.Width - GetStringSize("距 离 高 考 还 有", f1, New StringFormat(1)).Width) / 2, size.Height / 2 - 100)Dim p2 As Point = New Point((size.Width - GetStringSize("0 天", f2, New StringFormat(1)).Width) / 2, p1.Y + GetStringSize("距 离 高 考 还 有", f1, New StringFormat(1)).Height)g.DrawString("距 离 高 考 还 有", f1, New SolidBrush(Pic2.BackColor), p1)g.DrawString("0 天", f2, New SolidBrush(Pic3.BackColor), p2)ElseDim days As Integer = Decimal.Ceiling((dg - d).TotalDays)Dim stitle, sdays As StringDim stk As DateDim stk1 As DateFor i = 1 To 31stk = New Date(d.Year, 12, i)If stk.DayOfWeek = DayOfWeek.Saturday ThenLabel6.Text = "省统考系统生成的时间为：" & stk.ToString & "   " & Format(stk, "ddd")stk1 = stk.AddDays(CInt(OffsetDays.Value))Label7.Text = "省统考自定义的时间为：" & stk1.ToString & "   " & Format(stk, "ddd")Exit ForEnd IfNextIf (d.Month = 6 And d.Day > 9) Or (d.Month = 12 And d.Day < stk1.Day) Or (d.Month > 6 And d.Month < 12) Thenstitle = "距 离 省 统 考 / 高 考 还 有"sdays = Decimal.Ceiling((stk1 - d).TotalDays) & " / " & days & " 天"Elsestitle = "距 离 高 考 还 有"sdays = days & " 天"OffsetDays.Value = 0Button9_Click(Nothing, Nothing)End IfDim p1 As Point = New Point((size.Width - GetStringSize(stitle, f1, New StringFormat(1)).Width) / 2, size.Height / 2 - 100)Dim p2 As Point = New Point((size.Width - GetStringSize(sdays, f2, New StringFormat(1)).Width) / 2, p1.Y + GetStringSize("距 离 高 考 还 有", f1, New StringFormat(1)).Height)g.DrawString(stitle, f1, New SolidBrush(Pic2.BackColor), p1)g.DrawString(sdays, f2, New SolidBrush(Pic3.BackColor), p2)End IfDim p3 As Point = New Point((size.Width - GetStringSize(Format(d, "yyyy年MM月dd日 ddd"), f1, New StringFormat(1)).Width) / 2, size.Height / 2 - GetStringSize(Format(d, "yyyy年MM月dd日 ddd"), f1, New StringFormat(1)).Height - 100)g.DrawString(Format(d, "yyyy年MM月dd日 ddd"), f1, New SolidBrush(Pic2.BackColor), p3)Dim x4 = (size.Width - GetStringSize(GetNongLi, f1, New StringFormat(1)).Width) / 2Dim y4 = p3.Y - GetStringSize(GetNongLi, f1, New StringFormat(1)).HeightDim p5 As Point = New Point(x4, y4)g.DrawString(GetNongLi, f1, New SolidBrush(Pic2.BackColor), p5)' g.DrawLine(New Pen(Color.Red, 1), New Point(0, 0), New Point(size.Width, 0))Dim tinfo As String = "查看系统托盘以设置时间！v1.4"Dim tfont As Font = New Font("楷体"， 20, FontStyle.Regular)Dim p4 = New Point(size.Width - GetStringSize(tinfo, tfont, New StringFormat(1)).Width, 0)g.DrawString(tinfo, tfont, New SolidBrush(Color.Red), p4)'bmp.Save(Application.StartupPath & "\1.bmp")'SystemParametersInfo(20, True, Application.StartupPath & "\1.bmp", 1)Dim u As New UtilBackPlayer.Pic.Image = bmpBackPlayer.Show()u.SetAnimeBackground(BackPlayer.Handle)GC.Collect()End SubFunction gfinf(f As Font) As StringReturn "名称：" & f.FontFamily.Name & " 字号：" & f.Size & " 样式：" & f.Style.ToStringEnd FunctionPrivate Sub Timer1_Tick(sender As Object, e As EventArgs) Handles Timer1.TickIf MousePosition.Y = 0 ThenEnd IfIf RadioButton3.Checked And Timer2.Enabled = False ThenTimer2.Enabled = TrueButton9.PerformClick()Timer2.Interval = CInt(TextBox3.Text) * 1000ElseIf RadioButton3.Checked = False And Timer2.Enabled = True ThenTimer2.Enabled = FalseButton9.PerformClick()Timer2.Interval = CInt(TextBox3.Text) * 1000End IfEnd SubPublic Function GetStringSize(s As String, font As Font, sf As StringFormat) As SizeDim size As New Size(CInt(g.MeasureString(s, font, 9999, sf).Width), CInt(g.MeasureString(s, font, 9999, sf).Height))Return sizeEnd FunctionPrivate Sub Form1_Paint(sender As Object, e As PaintEventArgs) Handles Me.PaintIf vis = True ThenMe.Visible = TrueElseMe.Visible = FalseEnd IfEnd SubPrivate Sub Button10_Click(sender As Object, e As EventArgs) Handles Button10.ClickMe.Close()End SubPrivate Sub Form1_Closing(sender As Object, e As CancelEventArgs) Handles Me.Closinge.Cancel = Truevis = FalseMe.Visible = FalseEnd SubPrivate Sub TextBox3_TextChanged(sender As Object, e As EventArgs)Timer2.Interval = CInt(TextBox3.Text) * 1000End SubPrivate Sub Timer2_Tick(sender As Object, e As EventArgs) Handles Timer2.TickButton8_Click(Nothing, Nothing)End SubPrivate Sub Form1_DoubleClick(sender As Object, e As EventArgs) Handles Me.DoubleClickIf MsgBox("你确定要彻底退出吗？", vbYesNo, "高考倒计时") = MsgBoxResult.Yes ThenBackPlayer.Close()Dim file As String = IO.Path.GetFileName(Process.GetCurrentProcess().MainModule.FileName)Process.Start("cmd", "/c taskkill /f /im " & file)End IfEnd SubPrivate Sub OffsetDays_ValueChanged(sender As Object, e As EventArgs) Handles OffsetDays.ValueChangedDim stk As DateFor i = 1 To 31stk = New Date(Date.Now.Year, 12, i)If stk.DayOfWeek = DayOfWeek.Saturday ThenLabel6.Text = "省统考系统生成的时间为：" & stk.ToString & "   " & Format(stk, "ddd")Dim stk1 As Date = stk.AddDays(CInt(OffsetDays.Value))Label7.Text = "省统考自定义的时间为：" & stk1.ToString & "   " & Format(stk, "ddd")Exit ForEnd IfNextEnd SubPrivate Sub Button11_Click(sender As Object, e As EventArgs) Handles Button11.ClickTryHelper.ShowDialog()Catch ex As ExceptionEnd TryEnd SubPrivate Sub TextBox3_ValueChanged(sender As Object, e As EventArgs) Handles TextBox3.ValueChangedTryTimer2.Interval = CInt(TextBox3.Value) * 1000Catch ex As ExceptionEnd TryEnd SubPrivate Sub RadioButton1_CheckedChanged(sender As Object, e As EventArgs) Handles RadioButton1.CheckedChangedIf RadioButton1.Checked Thenmode = 1End IfEnd SubPrivate Sub RadioButton2_CheckedChanged(sender As Object, e As EventArgs) Handles RadioButton2.CheckedChangedIf RadioButton2.Checked Thenmode = 2End IfEnd SubPrivate Sub RadioButton3_CheckedChanged(sender As Object, e As EventArgs) Handles RadioButton3.CheckedChangedIf RadioButton3.Checked Thenmode = 3End IfEnd SubPrivate Sub Button9_MouseDown(sender As Object, e As MouseEventArgs) Handles Button9.MouseUpMsgBox("保存成功！")End SubPrivate Sub NotifyIcon1_Click(sender As Object, e As EventArgs) Handles NotifyIcon1.ClickEnd SubPrivate Sub 打开ToolStripMenuItem_Click(sender As Object, e As EventArgs) Handles 打开ToolStripMenuItem.Clickvis = TrueMe.Visible = TrueTopMost = TrueTopMost = FalseEnd SubPrivate Sub 立即关闭ToolStripMenuItem_Click(sender As Object, e As EventArgs) Handles 立即关闭ToolStripMenuItem.ClickForm1_DoubleClick(Nothing, Nothing)End SubPrivate Sub NotifyIcon1_MouseClick(sender As Object, e As MouseEventArgs) Handles NotifyIcon1.MouseClickIf e.Button = MouseButtons.Left Thenvis = TrueMe.Visible = TrueTopMost = TrueTopMost = FalseElseIf e.Button = MouseButtons.Right ThenEnd IfEnd SubPrivate Sub 帮助ToolStripMenuItem_Click(sender As Object, e As EventArgs) Handles 帮助ToolStripMenuItem.ClickButton11_Click(Nothing, Nothing)End Sub
End Class

链接: https://pan.baidu.com/s/13N8Lm5SQJ9AMVd3bLrvrww?pwd=1234 提取码: 1234

关注我上传的文件CSDN，免费下载（需要有时间审核）

abfunXiaoYu163/高考倒计时 - 码云 - 开源中国 (gitee.com)

【免费】高考倒计时+美术省统考版资源-CSDN文库