展开全部
参考代码:可以精确到秒,仔细研究
Dim nYear As Integer, nDay As Integer, nmonth As Integer, mday As Integer '本年的年、月、日变量以及目标年不足一636f707962616964757a686964616f31333262353431年的天数与当前年剩余天数之和
Dim tYear As Integer, tDay As Integer, oyear As Integer, tmonth As Integer '目标年的年、天数、本年与目标年之差
Dim nSec As Long, tSec As Long '今天已经过去的秒数、目标天0点距离截止点的秒数(其中nSec最终为倒计时不足一天的剩余秒数
Dim strNow1 As String, strNow2 As String, zhuti As String '取今天年月日和今天时分秒的字符串变量
Dim strEnd1 As String, strEnd2 As String '取目标截止时的年月日、时分秒的字符串变量
Dim h As Long, m As Long, s As Long '时分秒计数变量
Dim oday As Integer, pday As Integer, xday As Integer, zday As Integer '今天和目标天秒数之和大于1天的临时变量值和今年中本月以前的天数累加和计数变量,判月函数本月最大值取值
Dim i As Integer, k As Integer, flag As Integer '循环控制变量以及闰年处理中二月天数处理变量
Private Sub Command1_Click()
strNow1 = Format(Now, "hh:mm:ss")
strNow2 = Format(Now, "yyyy-mm-dd")
nYear = Val(Left(strNow2, 4))
nmonth = Val(Mid(strNow2, 6, 2))
nDay = Val(Right(strNow2, 2)) - 1 '今天之前本月已经过去的天数
h = Val(Left(strNow1, 2))
s = Val(Right(strNow1, 2))
m = Val(Mid(strNow1, 4, 3))
s = s + h * 3600 + m * 60 '今天已经过去的秒数
nSec = 86400 - s '今天还剩余的秒数
nSec = nSec + tSec '目标当天到截止点的秒数与今天已过去的秒数之和
If nSec > 86400 Then
nSec = nSec - 86400
oday = 1 '今天还剩余的秒数与目标天从零点到目标时间点的秒数之和大于86400(1天)时的处理
Else
oday = 0
End If
pday = 0
For i = 1 To nmonth - 1 '累计本年已经过去的天数
panyue i, nYear
pday = pday + zday 'pday是累加天数结果,zday是panyue函数返回结果
Next i
pday = pday + nDay '本年已经过去的整月天数加上本月已经过去的天数
If nYear Mod 4 = 0 And nYear Mod 100 <> 0 Or nYear Mod 400 = 0 Then
pday = 366 - pday + oday
mday = (pday + tDay) Mod 366
Else
pday = 365 - pday + oday
mday = (pday + tDay) Mod 365 '判断本年是否闰年,并做相应的天数处理
End If
If tYear - nYear > 0 Then
oyear = tYear - nYear - 1 + (tDay + oday) \ 365
Else
oyear = 0
End If
Timer1.Enabled = True
End Sub
Private Sub Command2_Click()
If Command2.Caption = "暂停" Then
Command2.Caption = "恢复"
flag = 1
ElseIf Command2.Caption = "恢复" Then
Command2.Caption = "暂停"
flag = 0
End If
End Sub
Private Sub Command3_Click()
Timer1.Enabled = False
Label2.Caption = "0"
Label4.Caption = "000"
Label6.Caption = "00000000"
End Sub
Sub showtime1()
'以下是独立时钟当前年当前月的最大取值设定
If nYear Mod 4 = 0 And nYear Mod 100 <> 0 Or nYear Mod 400 = 0 Then
k = 1
Else
k = 0
End If
Select Case nmonth
Case 1, 3, 5, 7, 8, 10, 12
xday = 31
Case 2
xday = 28 + k
Case 4, 6, 9, 11
xday = 30
End Select
'以下是独立时钟当前年月日、时分秒的进位处理
If s < 59 Then
s = s + 1
ElseIf s = 59 And m < 59 Then
s = 0
m = m + 1
ElseIf s = 59 And m = 59 And h < 23 Then
s = 0
m = 0
h = h + 1
ElseIf s = 59 And m = 59 And h = 23 And nDay < xday Then
s = 0
m = 0
h = 0
nDay = nDay + 1
ElseIf s = 59 And m = 59 And h = 23 And nDay = xday And nmonth < 12 Then
s = 0
m = 0
h = 0
nDay = 1
nmonth = nmonth + 1
ElseIf s = 59 And m = 59 And h = 23 And nDay = xday And nmonth = 12 And nYear < 9999 Then
s = 0
m = 0
h = 0
nDay = 1
nmonth = 1
nYear = nYear + 1
End If
'以下是倒计时当前秒以及跨越天结点和年结点的处理
If nSec > 0 Then
nSec = nSec - 1
ElseIf nSec = 0 And mday > 0 Then
nSec = 86400
nSec = nSec - 1
ElseIf nSec = 0 And mday = 0 And oyear > 0 Then
If nYear Mod 4 = 0 And nYear Mod 100 <> 0 Or nYear Mod 400 = 0 Then
k = 1
Else
k = 0
End If
nSec = 86400
nSec = nSec - 1
mday = 365 + k - 1
oyear = oyear - 1
End If
If flag <> 1 Then
Label2.Caption = oyear
Label4.Caption = mday
Label6.Caption = nSec
End If
End Sub
Private Sub Command4_Click()
Dim t1 As Long, t2 As Long, t3 As Long, t As Long
t1 = Timer
t = InputBox("请输入校正时间的秒数值!")
t2 = Timer
t3 = t2 - t1
nSec = nSec + t + t3
End Sub
Private Sub Command5_Click()
End
End Sub
Private Sub Form_Load()
nYear = 0: mday = 0: tYear = 0: tDay = 0: oyear = 0
nSec = 0: tSec = 0: tmonth = 0
i = 0: pday = 0
h = 0: m = 0: s = 0
nDay = 0: nmonth = 0
xday = 0: k = 0: zday = 0
strzhuti = InputBox$("请输入活动主题:", "", "奥运会")
strEnd1 = InputBox$("请输入倒计时截止日期:(格式:月-日-年)", "", "08-08-2008")
strEnd2 = InputBox$("请输入倒计时截止时间:(格式:时:分:秒)", "", "20:30:30")
tYear = Val(Right(strEnd1, 4))
tmonth = Val(Left(strEnd1, 2)) - 1
pday = 0
For i = 1 To tmonth '累计目标年从1月1日到目标日的天数
panyue i, tYear
pday = pday + zday
Next i
tDay = pday + Val(Mid(strEnd1, 4, 2)) - 1
tSec = Val(Left(strEnd2, 2)) * 3600 + Val(Mid(strEnd2, 4, 2)) * 60 + Val(Right(strEnd2, 2))
Label1.Caption = "距离" + Right(strEnd1, 4) + "年" + Left(strEnd1, 2) + "月" + Mid(strEnd1, 4, 2) + "日" + strzhuti + "还有:"
End Sub
Private Sub Timer1_Timer()
showtime1
End Sub
Sub panyue(xmonth As Integer, xyear As Integer)
If xyear Mod 4 = 0 And xyear Mod 100 <> 0 Or xyear Mod 400 = 0 Then
k = 1
Else
k = 0
End If
Select Case xmonth
Case 1, 3, 5, 7, 8, 10, 12
zday = 31
Case 2
zday = 28 + k
Case 4, 6, 9, 11
zday = 30
End Select
End Sub
本回答由提问者推荐
已赞过
已踩过<
你对这个回答的评价是?
评论
收起