■当前位置：首页 > VB 小程序 > 高考倒计时

　 　 　 18. 高考倒计时

　　本程序是一个倒计时小程序，高考时间可任意设置(默认为计算机当前年份的6月7日)，程序会自动调整字符大小和显示位置（居中）
　　默认标题为“高考”，程序运行后，可通过单击标题区字符“高考倒计时”进行修改，如：中考、放假，等等。
　　程序关闭时，会自动保存设定的高考时间和标题。下次启动程序，显示的是上次设定的时间和标题。
　 http://s3/middle/b1879bb4xc93f7efd6f42&690

' '本程序在 vb6 调试通过
' '在窗体上放置 3 个控件：Timer1、Text1、Label1，在属性窗口将 Label1 的 Index 属性设置为 0，其他控件及属性无需进行任何设置
'本人原创，转载请注明出处：

'百度 http://hi.baidu.com/100bd/blog/item/ae4fa8505627832f43a75b03.html

'新浪 http://blog.sina.com.cn/s/blog_b1879bb401018hcs.html

Dim ctStr As String
Private Sub Form_Load()
   Dim I As Long, Y As Long, nStr As String
   ctStr = Trim(GetSetting("xUnTime", "xOpt", "xCap", ""))
   If ctStr = "" Then ctStr = "高考"'默认标题
   
   Text1.Font.Bold = True
   Label1(0).AutoSize = True: Label1(0).Font.Bold = True
   Label1(0).BackStyle = 0
   For I = 1 To 5
      Load Label1(I): Label1(I).Visible = True
   Next
   Me.BackColor = &HFF8888
   Label1(0).ForeColor = &HFF0000
   Label1(0).ToolTipText = "单击可修改标题"
   
   nStr = Trim(GetSetting("xUnTime", "xOpt", "xTime", ""))
   'nStr = "" '****调试代码
   If nStr = "" Then'默认时间：为计算机当前年份的6月7日
      Y = Format(Date, "yyyy")
      I = DateDiff("s", Now, Y & "-6-7 9:00:00")
      If I < 0 Then Y = Y + 1
      nStr = Y & "-6-7 9:00:00"
   End If
   Text1.MaxLength = 20: Text1.Text = nStr
   Timer1.Enabled = True: Timer1.Interval = 1000
   Me.WindowState = vbMaximized'最大化
End Sub

Private Sub Form_Unload(Cancel As Integer)
   SaveSetting "xUnTime", "xOpt", "xCap", ctStr
   SaveSetting "xUnTime", "xOpt", "xTime", Text1.Text
End Sub

Private Sub Label1_Click(Index As Integer)
   '用户修改标题
   If Index <> 0 Then Exit Sub
   Dim nStr As String
   nStr = Trim(InputBox("请输入倒计时事件的标题：", "倒计时 - 设置标题", ctStr))
   If Right(nStr, 3) = "倒计时" Then nStr = Trim(Left(nStr, Len(nStr) - 3))
   If nStr = "" Then Exit Sub
   ctStr = nStr
   Call Form_Resize
End Sub

Private Sub Text1_Change()
   Call Timer1_Timer
   Call Form_Resize
End Sub

Private Sub Form_Resize()
   Dim I As Long, H As Single, F As Single, W1 As Single
   Dim S0 As Single, S1 As Single, S2 As Single, L1 As Single, L2 As Single
   
   S0 = 0
   S1 = 5 + LenB(StrConv(ctStr, vbFromUnicode))
   If S1 < 9 Then S1 = 9
   S2 = 0.5 + LenB(StrConv(Text1.Text, vbFromUnicode))
   If S2 < 16.5 Then S2 = 16.5
   
   F = Me.ScaleX(Me.ScaleWidth, Me.ScaleMode, 3) / (S0 * 2 + S1 + S2)'根据窗口宽度设置字体大小
   H = Me.ScaleY(Me.ScaleHeight, Me.ScaleMode, 3) / 12                '根据窗口高度设置字体大小
   If F > H Then F = H
   F = F - 1
   If F < 3 Then F = 3
   
   Text1.Font.Size = F
   hh = Text1.Font.Size
   
   Set Me.Font = Text1.Font
   W1 = Me.TextWidth("A")
   L1 = (Me.ScaleWidth - W1 * (S1 + S2)) * 0.5
   L2 = L1 + W1 * S1
   Text1.Width = W1 * S2
   
   Label1(0).Font.Size = F * 1.5
   For I = 1 To Label1.UBound
      Label1(I).Font.Size = F
   Next
   H = Label1(1).Height * 0.5

   '标题
   Me.Caption = ctStr & "倒计时"
   Label1(0).Caption = ctStr & "倒计时"
   Label1(0).Move (Me.ScaleWidth - Label1(0).Width) * 0.5, (Me.ScaleHeight - H * 12) * 0.4
   
   '当前时间
   Label1(1).Caption = "当前时间"
   Label1(1).Move L1, Label1(0).Top + H * 4.5: Label1(2).Move L2, Label1(1).Top
   
   '高考时间
   Label1(3).Caption = ctStr & "时间"
   Label1(3).Move L1, Label1(1).Top + H * 3
   Text1.Appearance = 0
   Text1.Move L2, Label1(3).Top, Text1.Width, Label1(3).Height
   
   '剩余时间
   Label1(4).Move L1, Label1(3).Top + H * 3: Label1(4).Caption = "剩余时间"
   Label1(5).Move L2, Label1(4).Top: Label1(5).ForeColor = 255
End Sub

Private Sub Timer1_Timer()
   Dim D As Long, H As Long, M As Long, S As Long
   On Error GoTo cuo
   Label1(2).Caption = Now
   S = DateDiff("s", Now, CDate(Text1.Text))
   If S < 1 Then Label1(5).Caption = "时间到": Exit Sub
   D = S \ 86400'3600 * 24
   S = S Mod 86400: H = S \ 3600
   S = S Mod 3600: M = S \ 60
   S = S Mod 60
   Label1(5).Caption = D & "天 " & H & "时" & M & "分" & S & "秒"
   Exit Sub
cuo:
   Label1(5).Caption = "输入的时间错误"
End Sub

■当前位置：首页 > VB 小程序 > 高考倒计时