VB.NET 高考倒計時LED屏顯效果
- 2019 年 11 月 1 日
- 筆記
倒計時原理:
用DateDiff函數計算出兩個時間的差值,然後通過timer控件,每秒鐘獲取一次時間差值,然後顯示出來!
LED效果原理:
用Graphics繪製,實現文字和圖片的遮罩(請看第二篇文章)
倒計時源碼
Public Class Count_down Dim L As Long, T As Long, X As Long, Y As Long ''' <summary> ''' 構造時差 ''' </summary> Structure Date_time Dim SC_D As Long ''時差天 Dim SC_H As Long ''時差時 Dim SC_M As Long ''時差分 Dim SC_S As Long ''時差秒 End Structure ''' <summary> ''' 獲取時差 ''' </summary> ''' <param name="D"></param> ''' <returns></returns> Function GET_SC(ByVal D As Date) As Date_time ''取時差 If IsDate(D) Then Dim SD As New Date_time With { .SC_D = DateDiff("d", Now, D), '取相差天數 .SC_H = DateDiff("h", Now, D) Mod 24, '取相差時數 .SC_M = DateDiff("n", Now, D) Mod 60, '取相差分數 .SC_S = DateDiff("s", Now, D) Mod 60 '取相差秒數 } Return SD Else MsgBox($"請輸入標準時間格式", MsgBoxStyle.Critical, "時間錯誤") End If End Function ''' <summary> ''' 計時器 ''' </summary> ''' <param name="sender"></param> ''' <param name="e"></param> Private Sub Timer1_Tick(sender As Object, e As EventArgs) Handles Timer1.Tick Dim S As Date_time = GET_SC("2020/06/07 8:00:00") Timer1.Interval = 1000 If S.SC_D = 0 And S.SC_H = 0 And S.SC_M = 0 And S.SC_S = 0 Then MASK_IMG("2020年高考開始啦!", $"同學們準備好了嗎?") Timer1.Enabled = False Exit Sub Else MASK_IMG("距離 2020年 高考", $"還剩 {S.SC_D} 天 {S.SC_H} 小時 {S.SC_M} 分 {S.SC_S}秒") End If End Sub ''' <summary> ''' LED ''' </summary> ''' <param name="s"></param> ''' <param name="STR"></param> Private Sub MASK_IMG(ByVal s As String, ByVal STR As String) Dim B As New Bitmap(Width, Height) Using G As Graphics = Graphics.FromImage(B) G.Clip = New Region(New Rectangle(0, 0, Width, Height)) G.SmoothingMode = Drawing2D.SmoothingMode.HighSpeed G.DrawString("微信公眾號關注:VB小源碼", New Font("黑體", Led1.Width * 0.011), Brushes.Red, New Point(Led1.Width * 0.25, Led1.Height * 0.42)) G.DrawString(s, New Font("微軟雅黑", Led1.Width * 0.019), Brushes.Yellow, New Point(Led1.Width * 0.01, Led1.Height * 0.05)) G.DrawString(STR, New Font("宋體", Led1.Width * 0.018), Brushes.LimeGreen, New Point(Led1.Width * 0.06, Led1.Height * 0.2)) G.DrawString("決戰高考，改變命運。屢挫屢戰，笑傲群雄。", New Font("仿宋", Led1.Width * 0.015), Brushes.Yellow, New Point(Led1.Width * 0.01, Led1.Height * 0.32)) End Using Led1.INPUT_IMG = B End Sub Private Sub Count_down_Load(sender As Object, e As EventArgs) Handles MyBase.Load Dim S As Date_time = GET_SC("2020/06/07 8:00:00") If (S.SC_D < 0 Or S.SC_H < 0 Or S.SC_M < 0 Or S.SC_S < 0) = True Then Exit Sub End If Timer1.Interval = 1 Timer1.Enabled = True End Sub
無邊框窗體移動部分
Private Sub Count_down_Closed(sender As Object, e As EventArgs) Handles Me.Closed End End Sub Private Sub Led1_MouseDown(sender As Object, e As MouseEventArgs) Handles Led1.MouseDown L = Led1.Left T = Led1.Top X = e.X Y = e.Y End Sub Private Sub Led1_MouseMove(sender As Object, e As MouseEventArgs) Handles Led1.MouseMove If Led1.Capture = True Then Top = e.Y + T - Y Left = e.X + L - X L = Left T = Top End If End Sub Private Sub Led1_KeyDown(sender As Object, e As KeyEventArgs) Handles Led1.KeyDown If e.KeyCode = Keys.Escape Then If MsgBox("是否要退出倒計時?", MsgBoxStyle.YesNo, "退出") = MsgBoxResult.Yes Then End End If End Sub
無邊框窗體放大部分
Private Sub Led1_MouseDoubleClick(sender As Object, e As MouseEventArgs) Handles Led1.MouseDoubleClick If WindowState = FormWindowState.Normal Then Led1.INPUT_IMG = New Bitmap(1, 1) Timer1.Interval = 1 WindowState = FormWindowState.Maximized Else WindowState = FormWindowState.Normal End If End Sub End Class
實例下載:
https://www.lanzous.com/i72udmj
今天教程到此結束啦!
