Private Sub Command1_Click()
Dim starttime As Date, endtime As Date
starttime = Now - 0.05
endtime = Now - 0.01
MsgBox "考试用时 " & Format(TimeSerial(0, 0, DateDiff("s", starttime, endtime)), "h 小时 n 分 s 秒")
End Sub
timer控件太不精确了,以下是使用api函数的计时:
Option Explicit
Private Declare Function GetTickCount Lib "kernel32" () As Long
Dim mintMinutes As Integer '逝去的分钟数
Private Sub cmdBegin_Click()
Do
TimeDelay 1000 '每一次延时1分钟
Loop Until mintMinutes >= 60 '总共60分钟
MsgBox "时间到,请马上停止答题!", vbInformation, "提示"
End Sub
Private Sub Form_Load()
cmdBegin.Caption = "开始计时"
End Sub
'等待过去多长时间,以毫秒计
Public Sub TimeDelay(DT As Long)
Dim TT As Long
TT = GetTickCount()
Do
DoEvents
DoEvents
If GetTickCount - TT < 0 Then TT = GetTickCount
Loop Until GetTickCount - TT >= DT
Option Explicit
Dim Hour_Int As Integer
Dim Minute_Int As Integer
Dim Second_Int As Integer
Dim S_Str As String
Dim M_Str As String
Dim H_Str As String
Dim Time_Str As String
' 开始倒计时
Private Sub Command1_Click()
Timer1.Enabled = True
Command2.Enabled = True
End Sub
' 暂停倒计时
Private Sub Command2_Click()
Timer1.Enabled = Not Timer1.Enabled
Select Case Timer1.Enabled
Case True
Command2.Caption = "暂停"
Case False
Command2.Caption = "继续"
End Select
End Sub
' 退出
Private Sub Command3_Click()
End
End Sub
Sub Form_Load()
Hour_Int = 0
Minute_Int = 30
Second_Int = 0
Timer1.Interval = 1000
Timer1.Enabled = False
Command2.Enabled = False
End Sub
Second_Int = Second_Int - 1
If Hour_Int = 0 And Minute_Int = 0 And Second_Int = -1 Then
MsgBox "时间到!!!"
End If
If Second_Int = -1 And Minute_Int > 0 Then
Minute_Int = Minute_Int - 1
Second_Int = 59
End If
If Minute_Int = 0 And Hour_Int > 0 Then
Hour_Int = Hour_Int - 1
Minute_Int = 59
End If
End Sub