VB多功能计时器代码
VB小程序
1、VB定时器'*************************************************************'新建一个窗体，放两个控件：label和timer'*************************************************************Public hor As LongPublic minu, sec As IntegerPrivate Sub Form_Load()'设置计时器时间间隔为1秒。
'考虑到Sub Timer1_Timer()中判断等操作要花时间，所以Timer1.Interval设为994 Timer1.Interval = 994Dim longTime, tmp As Long'********************************longTime = 65'时间值，要你自己从数据库取，我就不写了！'********************************'初始化显示时间hor = CLng(longTime / 3600 - 0.5)'小时数tmp = longTime - 3600 * hor '剩余秒数minu = CLng(tmp / 60 - 0.5) '分钟数tmp = tmp - 60 * minu'剩余秒数sec = tmp'秒数Label1.Caption = CStr(hor) + ":" + Format(CStr(minu), "##00") + ":" + Format(CStr(sec), "##00") End SubPrivate Sub Timer1_Timer()If sec = 0 ThenIf minu = 0 ThenIf hor = 0 ThenExit SubElsehor = hor - 1End Ifminu = 59Elseminu = minu - 1sec = 59End IfElsesec = sec - 1End IfLabel1.Caption = CStr(hor) + ":" + Format(CStr(minu), "##00") + ":" + Format(CStr(sec), "##00") End Sub2、VB倒计时Dim h, m, s As IntegerPrivate Sub Command1_Click()Label1.Visible = FalseText1.Visible = TrueIf Command1.Caption = "倒计时" Then Timer1.Enabled = TrueCommand1.Caption = "停止"Command2.Enabled = FalseElseTimer1.Enabled = FalseCommand1.Caption = "倒计时"Command2.Caption = "重设倒计时" Command2.Enabled = TrueEnd IfEnd SubPrivate Sub Command2_Click()If Command2.Caption = "重设倒计时" Then Call againCommand1.Enabled = TrueEnd IfEnd SubPrivate Sub Command3_Click()a = MsgBox("你确定要退出嗎")EndEnd SubPrivate Sub Form_Load()ClsText1.Text = ""a = MsgBox("以下是一個倒計時程序,請按以下要求輸入你要倒计的时间")h = Val(InputBox("请输入倒计时的,小時数,若无填0", "小時/输入", 0))m = Val(InputBox("请输入倒计时的,分钟数,若无填0", "小時/输入", 0))s = Val(InputBox("请输入倒计时的,秒数,若无填0", "小時/输入", 0))Label1.Caption = "你输入的时间是:" & Format(h, "00") & ":" & Format(m, "00") & ":" & Format(s, "00") & "如果沒有错误请点击倒计时按纽"Text1.Visible = FalseEnd SubPrivate Sub Timer1_Timer()If s > 0 Thens = s - 1End IfIf s < 1 And m > 0 Thenm = m - 1s = 60End IfIf m < 1 And s = 0 And h > 0 Thenh = h - 1m = 60End IfIf h < 0 Thenh = 0End IfIf m < 0 Thenm = 0End IfText1.Text = Format(h, "00") & ":" & Format(m, "00") & ":" & Format(s, "00")If h = 0 And m = 0 And s = 0 ThenText1.Text = "時間到了"Command1.Caption = "倒计时"Command1.Enabled = FalseTimer1.Enabled = FalseCommand2.Enabled = TrueEnd IfEnd SubSub again()ClsText1.Text = ""a = MsgBox("以下是一個倒計時程序,請按以下要求輸入你要倒计的时间")h = Val(InputBox("请输入倒计时的,小時数,若无填0", "小時/输入", 0))m = Val(InputBox("请输入倒计时的,分钟数,若无填0", "小時/输入", 0))s = Val(InputBox("请输入倒计时的,秒数,若无填0", "小時/输入", 0))Label1.Caption = "你输入的时间是:" & Format(h, "00") & ":" & Format(m, "00") & ":" & Format(s, "00") & "如果沒有错误请点击倒计时按纽"Text1.Visible = FalseLabel1.Visible = TrueEnd Sub3、VB应该怎样取得本机上网用的动态IP应该是电信局动态分配给宽带用户的那种动态IP。
VB计时器的编辑
m = Val(Mid(strNow1, 4, 3))
s = s + h * 3600 + m * 60 '今天已经过去的秒数
nSec = 86400 - s + tSec '目标当天到截止点的秒数与今天已过去的秒数之和
If nSec > 86400 Then
3）程序中调用系统时间使用了“Now”函数，可以按照“小时：分钟：秒”的形式返回当前时间。
4）为保证应用程序的灵活性，应在倒计时牌上设有暂停、继续、时间校正、时区切换，结束运行等特殊要求的激发点。
5）按照需要构筑程序框架并编写应用程序。
六、调试过程及实验结果
实验界面：
七、附录（源程序清单）
Dim a As Long, b As Long, c As Long, mmonth As Integer
毅字楼404西北工业大学20102011学年第一学期软件技术实验报告七附录源程序清单dimaaslongbaslongcaslongmmonthasintegerdimnyearasintegerndayasintegernmonthasintegermdayasinteger本年的年月日变量以及目标年不足一年的天数与当前年剩余天数之和dimtyearasintegertdayasintegeroyearasintegertmonthasinteger目标年的年天数本年与目标年之差dimnsecaslongtsecaslong今天已经过去的秒数目标天0点距离截止点的秒数其中nsec最终为倒计时不足一天的剩余秒数dimstrnow1asstringstrnow2asstringzhutiasstring取今天年月日和今天时分秒的字符串变量dimstrend1asstringstrend2asstring取目标截止时的年月日时分秒的字符串变量dimhaslongmaslongsaslong时分秒计数变量dimodayasintegerpdayasintegerxdayasintegerzdayasinteger今天和目标天秒数之和大于1天的临时变量值和今年中本月以前的天数累加和计数变量判月函数本月最大值取值dimiasintegerkasintegerflagasinteger循环控制变量以及闰年处理中二月天数处理变量privatesubcheck1clicktext1text南非世界杯
VB计算器(界面设计全部代码)
VB计算器此计算器能够实现加减乘除等一系列的功能。
还有实现显示系统时间的附加功能。
程序设计：0-9和点在command1的组内。
其他的按钮式运算符和其他功能。
正切和余切有对特殊值进行警告，除也有对除数为零的情况提示警告，还有阶乘等一系列计算溢出的情况提出警告，还有很多需要完善。
这仅供参考。
Public sum As DoublePublic k As Stri ngPublic dia n As Boolea nPublic b As In tegerPublic poin tflag As Boolea nDim clearFlag As Boolea nPublic F As Long'Dim start As boole nPublic resl As Boolean ' 运算结果存储在resl里数字按钮在一个组内，点Public ff As Double 'resl 里是否为空'llllllllllllllllllllllllllllllllllllllllllllllllllllllll击按钮输入数字 lllllllllllllllllllllllllllllllllllllllllllPrivate Sub comma nd1_click(l ndex As In teger) Select Case In dex Case 1If Not clearFlag The n ' 不是等号，那么显示 1 Text1.Text = Text1.Text & 1 Else'是等号，那么清空Text1.Text = 1 clearFlag = False End IfIf Len(Text1.Text) = 2 And InStr(1, Text1, "0") = 1 Then Text1 = Right(Text1, 1) '如果第一位的数位 0，字符串的长度为 2.那么取字符串右面的数，即两个数中右面的数Case 2If Not clearFlag Then Text1.Text = Text1.Text & 2 ElseText1.Text = 2 clearFlag = False End IfIf Len (Text1.Text) = 2 And In Str(1, Text1, "0") = 1 The n Text1 : Case 3 If Not clearFlag The n Text1.Text = Text1.Text & 3 Else=Right(Text1, 1)Text1.Text clearFlag = End If=3 False If Len (Text1.Text) = 2 And In Str(1, Text1, "0") = 1 The n Text1 : =Right(Text1, 1)Case 4If Not clearFlag The nText1.Text =Text1.Text & 4ElseText1.Text =4clearFlag = FalseEnd IfIf Len (Text1.Text) = 2 And In Str(1, Text1, "0") = 1 The n Text1 : =Right(Text1, 1)Case 5If Not clearFlag ThenTextl.Text = Textl.Text & 5 ElseTextl.Text = 5 clearFlag = False End IfIf Len(Text1.Text) = 2 And InStr(1, Text1, "0")= =1 The n Text1 ==Right(Text1, 1)Case 6If Not clearFlag The nText1.Text =Text1.Text & 6ElseText1.Text =6clearFlag = End IfFalseIf Len(Text1.Text) = 2 And InStr(1, Text1, "0")= =1 The n Text1= =Right(Text1, 1)Case 7If Not clearFlag The n Text1.Text = Text1.Text & 7 ElseTextl.Text = 7 clearFlag = False End IfIf Len(Textl.Text) = 2 And InStr(1, Textl, "0") = 1 Then Textl = Right(Text1, 1) Case 8If Not clearFlag The n Textl.Text = Textl.Text & 8 ElseTextl.Text = 8 clearFlag = False End IfIf Len(Textl.Text) = 2 And InStr(1, Textl, "0") = 1 Then Textl = Right(Text1, 1) Case 9If Not clearFlag The n Text1.Text = Text1.Text & 9 ElseText1.Text = 9 clearFlag = False End IfIf Len(Text1.Text) = 2 And InStr(1, Text1, "0") = 1 Then Text1 = Right(Text1, 1) Case 0定义加号按钮 //////////////////////////////////////If Not clearFlag Then Textl.Text = Textl.Text & 0 ElseText1.Text = 0 clearFlag = False End IfIf Len(Text1.Text) = 2 And InStr(1, Text1, "0") = 1 Then Text1 = Right(Text1, 1) Case 10If Not clearFlag The n Text1.Text = Text1.Text + "." ElseText1.Text ="" clearFlag = False End If7///////////////////////////////////////////////// 对输入点 的个数进行约 束///////////////////////////////////////////////////////////If (In Str(Text1.Text, ".")= =1) The n 对点的处理，检查是否有点，有点再输入的话为空，否则加入其中Textl.Text =""End IfIf InStr(Text1.Text, ".") < Len(Textl.Text) Then Textl.Text = Left(Text1.Text, Len(Textl.Text) - 1) End IfEnd SelectText1.SetFocus End Sub '////////////////////////Private Sub comma nd2_click() If Text1.Text = "" The n End IfIf Trim(Text1.Text) <> "" Then sum = Text1.Text Text1.Text ="" k = "+" Else Exit Sub End If End Sub 7////////////////////////定义减号按钮 ////////////////////////////////////// Private Sub comma nd3_click()定义除号按钮If Text1.Text = "" Then End IfIf Trim(Text1.Text) <> "" The n sum = Text1.Text ' 第一个数字填入方框里 Text1.Text =""' 方框的值置空k ="-" Else Exit Sub End If End Sub '///////////////////////定义乘号按钮 ////////////////////////////////////////Private Sub comma nd4_click()If Text1.Text = "" The n End IfIf Trim(Text1.Text) <> "" Then sum = Text1.Text Text1.Text ="" k = "*" Else Exit Sub End If End Sub '/////////////////////////////////////////////////////////////////// Private Sub comma nd5_click() If Text1.Text = "" Then End IfIf Trim(Text1.Text) <> "" Then sum = Text1.Text Text1.Text ="" k = "/" Else Exit Sub End If End Sub'IIIIIIIIIIIIIIIIIIIIIIIIIIII 定 义sin号 按钮/////////////////////////////////////Private Sub comma nd1O_click() If Text1.Text = "" Then End IfIf Trim(Text1.Text) <> "" The n sum = Text1.TextElseExit SubEnd IfEnd Sub'///////////////////////////// 定义cos 按钮/////////////////////////////////////Private Sub comma nd11_click()If Text1.Text = "" The nEnd IfIf Trim(Text1.Text) <> "" The nsum = Text1.Textk ="cos"ElseExit SubEnd IfEnd Sub'///////////////////////////// 定义tan 按钮////////////////////////////////////Private Sub comma nd12_click()If Text1.Text = "" The nEnd IfIf Trim(Text1.Text) <> "" The nsum = Text1.Textk = "tan"ElseExit SubEnd IfEnd Sub'////////////////////////// 定义cot 按钮//////////////////////////////////////Private Sub comma nd13_click()If Text1.Text = "" The nEnd IfIf Trim(Text1.Text) <> "" Then sum = Textl.Textk = "cot"ElseExit SubEnd IfEnd Sub7////////////////////////// 定义人按钮///////////////////////////////////////Private Sub Comma nd14_click()If Textl.Text = "" The nExit SubIf Trim(Textl.Text) <> "" The nsum = Textl.TextTextl.Text =""k = "A"ElseExit SubEnd IfEnd Sub'///////////////////////// 定义2A ///////////////////////////////////////////Private Sub comma nd15_click()If Textl.Text = "" The nExit SubEnd IfIf Trim(Textl.Text) <> "" The nsum = Textl.Textk = "2人"ElseExit SubEnd IfEnd Sub'/////////////////////// 定义3A 按钮/////////////////////////////////////////// Private Sub comma nd16_click()If Textl.Text = "" The nExit SubEnd IfIf Trim(Textl.Text) <> "" The nsum = Textl.Textk = "3A"ElseExit SubEnd IfEnd Sub'IIIIIIIIIIIIIIIIIIII定义X!按钮///////////////////////////////////////////// Private Sub comma nd17_click()If Text1.Text = "" The nExit SubEnd IfIf Trim(Text1.Text) <> "" The nsum = Text1.Textk = "x!"ElseExit SubEnd If'////////////////// 定义sqrt 按钮////////////////////////////////////////////// Private Sub comma nd18_click()If Text1.Text = "" The nExit SubEnd IfIf Trim(Text1.Text) <> "" The nsum = Text1.Textk = "sqrt"ElseExit SubEnd IfEnd Sub'///////////////////////////// 定义阶乘的函数////////////////////////////////// Private Fu nction Ni(N As Long) As Boolea n 'Ni = FalseDim Mm As Long 'Dim F1 As Lo ngF = 1For Mm = 1 To NIf Mm > 12 The n 'If F1 > The n Ni = False Exit Fun cti on End IfF = F * MmNext MmNi = TrueEnd FunctionPrivate Sub equalbut_click() clearFlag = FalseEnd SubPrivate Sub comma nd6_click()If Trim(Text1.Text) <> "" Then 'Dim F As DoubleDim a As DoubleDim pi As DoubleDim i, j As In tegerpi = 3.14159265358979If Text1.Text > 2147483647 ThenMsgBox "溢出,请确认", vbExclamation, Me.CaptionExit SubEnd If a = Text1.Text clearFlag = TrueIf k = "+" Then sum = sum + a Text1.Text = sumElseIf k = "s in" The n sum = Sin(a * pi / 180) Textl.Text = sumElseIf k = "cos" ThenDim t As In tegert = a Mod 180 - 90If t = 0 ThenText1.Text = 0If m = 0 The n MsgBox " ElseElsesum = Cos(a * pi / 180) Textl.Text = sum End IfElseIf k = "tan" Then Dim m As In teger Dim N As In teger m = a Mod 180 - 90(90+180*n )度的正切值无意义，请重新输入 sum = (Tan(a * pi / 180)) Textl.Text = sum End IfElseIf k = "cot" The n If a = 0 The n MsgBox "0 度余切没有意义！请重新输入!Elsesum = 1 / (Tan(a * pi / 180)) Textl.Text = sum End If'ElseIf k = "x!" The n 'If Text1.Text > 0 The n 'Call fact(Text1.Text, F) ' Text1.Text = F'ElseIf Text1.Text = 0 The n 'sum = 1' Text1.Text = sum'ElseIf Text1.Text < 0 The n 'MsgBox " 负数没有阶乘！ ”'End If减法运算Elself k = "x!" The nIf Ni(Textl.Text) = False The nMsgBox "溢出", vbExclamation, Me.CaptionText1.Text =""Exit SubElseText1.Text = FEnd IfElself k = "2A " The nTextl.Text = Val(Textl.Text) * Val(Textl.Text)Elself k = "3A" The nTextl.Text = Val(Textl.Text) * Val(Textl.Text) * Val(Textl.Text) Elself k = "sqr" The nIf a >= 0 The nsum = Math.Sqr(a)Textl.Text = sumElseMsgBox "开方数不能为负数！”End If Elself k = "A" The n sum =sum A a Textl.Text = sum Elself k = "-" The n sum = sum - a Textl.Text = sum resl = 1Elself k = "*" The n sum = sum * a Textl.Text = sum Elself k = "/" The nIf Textl.Text = 0 The nMsgBox "除数不能为零！请重新输入Textl.Text =""Elsesum = sum / aTextl.Text = sumIf Len( Textl.Text) > 14 The nMsgBox "溢出,请确认", vbExclamation, Me.Caption Exit SubEnd IfExit SubEnd IfEnd IfEnd IfEnd SubPrivate Sub Comma nd9_Click()If Len(Text1.Text) >= 2 ThenText1.Text = Left(Text1.Text, Len(Text1.Text) - 1) ElseText1.Text =""End IfEnd SubPrivate Sub form」。
VB2015编写时间小工具_倒顺计时_定时关机_闹钟等
PublicClass Form1Dim x, y, z AsBytePrivateSub Form1_Load(sender AsObject, e As EventArgs) HandlesMyBase.Loady = 0z = 0Dim thisDay AsInteger = Microsoft.VisualBasic.DateAndTime.Day(Now)'使用 Day 函数，可能需要用 Microsoft.VisualBasic 命名空间限定该函数，因为 System.Windows.Forms 命名空间将 Day 定义为枚举TextBox1.Text = 0TextBox2.Text = 0TextBox3.Text = 0TextBox5.Text = Year(Now)TextBox6.Text = Month(Now)TextBox7.Text = thisDayTextBox8.Text = Hour(Now)TextBox9.Text = Minute(Now)TextBox10.Text = Year(Now)TextBox11.Text = Month(Now)TextBox12.Text = thisDayTextBox13.Text = Hour(Now)TextBox14.Text = Minute(Now)EndSub'Private Sub AxMMControl1_BackClick(sender As Object, e As AxMCI.DmciEvents_BackClickEvent) Handles AxMMControl1.BackClick'使用COM有件中的:Microsoft Multimedia Contril (SP3) 音乐播放'End SubPrivateSub Button1_Click(sender AsObject, e As EventArgs) Handles Button1.ClickTimer1.Enabled = Truex = 1Button4.Enabled = FalseEndSubPrivateSub Button2_Click(sender AsObject, e As EventArgs) Handles Button2.Click'mand = "close" '使用COM有件中的:Microsoft Multimedia Contril (SP3) 音乐播放AxWindowsMediaPlayer1.close() ''使用COM有件中的Microsoft Media Player.这里是关闭播放x = 0EndSubPrivateSub Button3_Click(sender AsObject, e As EventArgs) Handles Button3.ClickOpenFileDialog1.InitialDirectory = "c:\"Dim result? AsBoolean = OpenFileDialog1.ShowDialog()If result = TrueThenTextBox4.Text = OpenFileDialog1.FileNameEndIf'AxMMControl1.FileName = TextBox4.Text '使用COM有件中的:Microsoft Multimedia Contril (SP3) 音乐播放EndSubPrivateSub Button4_Click(sender AsObject, e As EventArgs) Handles Button4.ClickTimer1.Enabled = Truex = 2Button1.Enabled = FalseEndSubPrivateSub Button5_Click(sender AsObject, e As EventArgs) Handles Button5.Clicky = 0x = 0z = 0TextBox1.Text = 0TextBox2.Text = 0TextBox3.Text = 0'mand = "close" '使用COM有件中的:Microsoft Multimedia Contril (SP3) 音乐播放 AxWindowsMediaPlayer1.close() ''使用COM有件中的Microsoft Media Player.这里是关闭播放 Button6.BackColor = Color.GoldButton6.ForeColor = Color.BlueButton6.Text = "启动"TextBox1.Enabled = TrueTextBox2.Enabled = TrueTextBox3.Enabled = TrueButton1.Enabled = TrueButton4.Enabled = TrueButton6.Enabled = TrueButton7.Enabled = TrueTextBox5.Enabled = TrueTextBox6.Enabled = TrueTextBox7.Enabled = TrueTextBox8.Enabled = TrueTextBox9.Enabled = TrueTextBox10.Enabled = TrueTextBox11.Enabled = TrueTextBox12.Enabled = TrueTextBox13.Enabled = TrueTextBox14.Enabled = TrueButton7.BackColor = Color.LimeButton7.ForeColor = Color.BlueButton7.Text = "启用"Label5.Text = "倒计时/顺计时时间:"Label5.ForeColor = Color.GreenEndSubPrivateSub Timer1_Tick(sender AsObject, e As EventArgs) Handles Timer1.TickIf x = 1 ThenTextBox1.Enabled = FalseTextBox2.Enabled = FalseTextBox3.Enabled = FalseLabel5.Text = "倒计时时间:"Label5.ForeColor = Color.RedIf TextBox1.Text <> 0 ThenTextBox1.Text -= 1EndIfIf (TextBox1.Text + TextBox2.Text + TextBox3.Text) <> 0 ThenIf TextBox1.Text = 0 ThenIf TextBox2.Text = 0 ThenTextBox1.Text = 60TextBox2.Text = 60TextBox3.Text -= 1EndIfIf TextBox2.Text <> 0 ThenTextBox1.Text = 60TextBox2.Text -= 1EndIfEndIfEndIfIf x = 1 Or x = 2 ThenIf (TextBox1.Text + TextBox2.Text + TextBox3.Text) = 0 ThenTimer1.Enabled = FalseTextBox1.Enabled = TrueTextBox2.Enabled = TrueTextBox3.Enabled = TrueButton1.Enabled = TrueButton4.Enabled = True'mand = "open" '使用COM有件中的:Microsoft Multimedia Contril (SP3) 音乐播放'mand = "play" '使用COM有件中的:Microsoft Multimedia Contril (SP3) 音乐播放AxWindowsMediaPlayer1.URL = TextBox4.Text '使用COM有件中的Microsoft Media Player.这里是播放的文件MsgBox("时间到!", 48, "提示!")Label5.Text = "倒计时/顺计时时间:"Label5.ForeColor = Color.GreenEndIfEndIfEndIfIf x = 2 ThenLabel5.Text = "顺计时时间:"Label5.ForeColor = Color.RedTextBox1.Enabled = FalseTextBox2.Enabled = FalseTextBox3.Enabled = FalseTextBox1.Text += 1If TextBox1.Text = 59 ThenTextBox1.Text = 0TextBox2.Text += 1If TextBox2.Text = 59 ThenTextBox2.Text = 0TextBox3.Text += 1EndIfEndIfEndIfEndSubPrivateSub Timer2_Tick(sender AsObject, e As EventArgs) Handles Timer2.TickDim a AsBytea = Weekday(Now)If a = 1 ThenLabel8.Text = "星期天"EndIfIf a = 2 ThenLabel8.Text = "星期一"EndIfIf a = 3 ThenLabel8.Text = "星期二"EndIfIf a = 4 ThenLabel8.Text = "星期三"EndIfIf a = 5 ThenLabel8.Text = "星期四"EndIfIf a = 6 ThenLabel8.Text = "星期五"EndIfIf a = 7 ThenLabel8.Text = "星期六"EndIfLabel6.Text = DateStringLabel7.Text = TimeStringDim thisDay AsInteger = Microsoft.VisualBasic.DateAndTime.Day(Now)If y = 1 ThenIf TextBox5.Text = Year(Now) ThenIf TextBox6.Text = Month(Now) ThenIf TextBox7.Text = thisDay ThenIf TextBox8.Text = Hour(Now) ThenIf TextBox9.Text = Minute(Now) Theny = 0Button7.BackColor = Color.LimeButton7.ForeColor = Color.BlueButton7.Text = "启用"Button7.Enabled = TrueTextBox5.Enabled = TrueTextBox6.Enabled = TrueTextBox7.Enabled = TrueTextBox8.Enabled = TrueTextBox9.Enabled = TrueAxWindowsMediaPlayer1.URL = TextBox4.Text MsgBox("闹钟时间到!", 48, "闹钟提示!") EndIfEndIfEndIfEndIfEndIfEndIfIf z = 1 ThenIf TextBox10.Text = Year(Now) ThenIf TextBox11.Text = Month(Now) ThenIf TextBox12.Text = thisDay ThenIf TextBox13.Text = Hour(Now) ThenIf TextBox14.Text = Minute(Now) Thenz = 0Button6.BackColor = Color.GoldButton6.ForeColor = Color.BlueButton6.Text = "启动"Button6.Enabled = TrueTextBox10.Enabled = TrueTextBox11.Enabled = TrueTextBox12.Enabled = TrueTextBox13.Enabled = TrueTextBox14.Enabled = TrueShell("shutdown.exe -f -s -t 3")'MsgBox("时间到!", 48, "错误提示!")EndIfEndIfEndIfEndIfEndIfEndIfEndSubPrivateSub TextBox1_KeyPress(sender AsObject, e As KeyPressEventArgs) Handles TextBox1.KeyPress Const xStr AsString = "0123456789"e.KeyChar = IIf(InStr(xStr & Chr(8) & Chr(13), e.KeyChar.ToString), e.KeyChar, Nothing) If e.KeyChar = Chr(13) ThenTextBox2.Focus()' Call Command1_Click 回车键事件,这里调用按键1内的单击事件EndIfEndSubPrivateSub TextBox1_LostFocus(sender AsObject, e As EventArgs) Handles TextBox1.LostFocusDim a AsStringa = Val(TextBox1.Text) 'Val'转换为数值型If TextBox1.Text <>""ThenIf a > 60 Or a < 0 ThenMsgBox("请输入正确的时间;0~60!", 48, "错误提示!")TextBox1.Focus() '重新获取焦点TextBox1.Text = ""EndIfEndIfEndSubPrivateSub TextBox2_KeyPress(sender AsObject, e As KeyPressEventArgs) Handles TextBox2.KeyPress Const xStr AsString = "0123456789"e.KeyChar = IIf(InStr(xStr & Chr(8) & Chr(13), e.KeyChar.ToString), e.KeyChar, Nothing) If e.KeyChar = Chr(13) ThenTextBox3.Focus()' Call Command1_Click 回车键事件,这里调用按键1内的单击事件EndIfEndSubPrivateSub TextBox2_LostFocus(sender AsObject, e As EventArgs) Handles TextBox2.LostFocusDim a AsStringa = Val(TextBox2.Text) 'Val'转换为数值型If TextBox2.Text <>""ThenIf a > 60 Or a < 0 ThenMsgBox("请输入正确的时间;0~60!", 48, "错误提示!")TextBox2.Focus() '重新获取焦点TextBox2.Text = ""EndIfEndSubPrivateSub TextBox3_KeyPress(sender AsObject, e As KeyPressEventArgs) Handles TextBox3.KeyPress Const xStr AsString = "0123456789"e.KeyChar = IIf(InStr(xStr & Chr(8) & Chr(13), e.KeyChar.ToString), e.KeyChar, Nothing) If e.KeyChar = Chr(13) ThenButton1.Focus()' Call Command1_Click 回车键事件,这里调用按键1内的单击事件EndIfEndSubPrivateSub Timer3_Tick(sender AsObject, e As EventArgs) Handles Timer3.TickEndSubPrivateSub Button6_Click(sender AsObject, e As EventArgs) Handles Button6.ClickDim a AsByteDim thisDay AsInteger = Microsoft.VisualBasic.DateAndTime.Day(Now)If Val(TextBox10.Text + TextBox11.Text + TextBox12.Text + TextBox13.Text + TextBox14.Text) >Val(Year(Now) & Month(Now) & thisDay & Hour(Now) & Minute(Now)) Thena = MsgBox("确认启用定时关机!", 305, "警示!")If a = vbOK Thenz = 1Button6.BackColor = Color.RedButton6.ForeColor = Color.BlackButton6.Text = "启动中"Button6.Enabled = FalseTextBox10.Enabled = FalseTextBox11.Enabled = FalseTextBox12.Enabled = FalseTextBox13.Enabled = FalseTextBox14.Enabled = FalseElsez = 0Button6.Enabled = TrueTextBox10.Enabled = TrueTextBox11.Enabled = TrueTextBox12.Enabled = TrueTextBox13.Enabled = TrueTextBox14.Enabled = TrueEndIfElseMsgBox("请输入正确的时间!", 48, "错误提示!")TextBox14.Focus() '重新获取焦点EndIfEndSubPrivateSub Button7_Click(sender AsObject, e As EventArgs) Handles Button7.ClickDim thisDay AsInteger = DateAndTime.Day(Now)If Val(TextBox5.Text + TextBox6.Text + TextBox7.Text + TextBox8.Text + TextBox9.Text) >Val(Year(Now) & Month(Now) & thisDay & Hour(Now) & Minute(Now)) Theny = 1MsgBox("请输入正确的时间!", 48, "错误提示!")TextBox9.Focus() '重新获取焦点EndIfIf y = 1 ThenButton7.BackColor = Color.CrimsonButton7.ForeColor = Color.BlackButton7.Text = "启用中"Button7.Enabled = FalseTextBox5.Enabled = FalseTextBox6.Enabled = FalseTextBox7.Enabled = FalseTextBox8.Enabled = FalseTextBox9.Enabled = FalseEndIfEndSub'Private Sub TextBox3_LostFocus(sender As Object, e As EventArgs) Handles TextBox3.LostFocus' Dim a As String' a = Val(TextBox3.Text) 'Val'转换为数值型' If TextBox3.Text <> "" Then' If a > 60 Or a < 0 Then' MsgBox("请输入正确的时间;0~60!", 48, "错误提示!")' TextBox3.Focus() '重新获取焦点' TextBox3.Text = ""' End If' End If'End SubPrivateSub TextBox5_KeyPress(sender AsObject, e As KeyPressEventArgs) Handles TextBox5.KeyPress Const xStr AsString = "0123456789"e.KeyChar = IIf(InStr(xStr & Chr(8) & Chr(13), e.KeyChar.ToString), e.KeyChar, Nothing) If e.KeyChar = Chr(13) ThenTextBox6.Focus()' Call Command1_Click 回车键事件,这里调用按键1内的单击事件EndIfEndSubPrivateSub TextBox5_LostFocus(sender AsObject, e As EventArgs) Handles TextBox5.LostFocusDim a AsStringa = Val(TextBox5.Text) 'Val'转换为数值型If TextBox5.Text <>""ThenIf a > 9999 Or a < Year(Now) ThenMsgBox("请输入正确的时间,当前年份~9999年!", 48, "错误提示!")TextBox5.Focus() '重新获取焦点TextBox5.Text = Year(Now)EndIfEndIfEndSubPrivateSub TextBox6_KeyPress(sender AsObject, e As KeyPressEventArgs) Handles TextBox6.KeyPress Const xStr AsString = "0123456789"e.KeyChar = IIf(InStr(xStr & Chr(8) & Chr(13), e.KeyChar.ToString), e.KeyChar, Nothing) If e.KeyChar = Chr(13) ThenTextBox7.Focus()' Call Command1_Click 回车键事件,这里调用按键1内的单击事件EndIfEndSubPrivateSub TextBox6_LostFocus(sender AsObject, e As EventArgs) Handles TextBox6.LostFocusDim a AsStringa = Val(TextBox6.Text) 'Val'转换为数值型If TextBox6.Text <>""ThenIf a > 12 Or a <= 0 ThenMsgBox("请输入正确的时间,1~12!", 48, "错误提示!")TextBox6.Focus() '重新获取焦点TextBox6.Text = Month(Now)EndIfEndIfEndSubPrivateSub TextBox7_KeyPress(sender AsObject, e As KeyPressEventArgs) Handles TextBox7.KeyPress Const xStr AsString = "0123456789"e.KeyChar = IIf(InStr(xStr & Chr(8) & Chr(13), e.KeyChar.ToString), e.KeyChar, Nothing) If e.KeyChar = Chr(13) ThenTextBox8.Focus()' Call Command1_Click 回车键事件,这里调用按键1内的单击事件EndIfEndSubPrivateSub TextBox7_LostFocus(sender AsObject, e As EventArgs) Handles TextBox7.LostFocusDim a AsStringDim thisDay AsInteger = DateAndTime.Day(Now)a = Val(TextBox7.Text) 'Val'转换为数值型If TextBox7.Text <>""ThenIf a > 31 Or a <= 0 ThenMsgBox("请输入正确的时间,1~31!", 48, "错误提示!")TextBox7.Focus() '重新获取焦点TextBox7.Text = thisDayEndIfEndIfEndSubPrivateSub TextBox8_KeyPress(sender AsObject, e As KeyPressEventArgs) Handles TextBox8.KeyPress Const xStr AsString = "0123456789"e.KeyChar = IIf(InStr(xStr & Chr(8) & Chr(13), e.KeyChar.ToString), e.KeyChar, Nothing) If e.KeyChar = Chr(13) ThenTextBox9.Focus()' Call Command1_Click 回车键事件,这里调用按键1内的单击事件EndIfEndSubPrivateSub TextBox8_LostFocus(sender AsObject, e As EventArgs) Handles TextBox8.LostFocusDim a AsStringDim thisDay AsInteger = DateAndTime.Day(Now)a = Val(TextBox8.Text) 'Val'转换为数值型If TextBox8.Text <>""ThenIf a > 23 Or a < 0 ThenMsgBox("请输入正确的时间,00~23!", 48, "错误提示!")TextBox8.Focus() '重新获取焦点TextBox8.Text = Hour(Now)EndIfEndIfEndSubPrivateSub TextBox9_KeyPress(sender AsObject, e As KeyPressEventArgs) Handles TextBox9.KeyPress Const xStr AsString = "0123456789"e.KeyChar = IIf(InStr(xStr & Chr(8) & Chr(13), e.KeyChar.ToString), e.KeyChar, Nothing) If e.KeyChar = Chr(13) ThenButton7.Focus()' Call Command1_Click 回车键事件,这里调用按键1内的单击事件EndIfEndSubPrivateSub TextBox9_LostFocus(sender AsObject, e As EventArgs) Handles TextBox9.LostFocusDim a AsStringDim thisDay AsInteger = DateAndTime.Day(Now)a = Val(TextBox9.Text) 'Val'转换为数值型If TextBox9.Text <>""ThenIf a > 59 Or a <= 0 ThenMsgBox("请输入正确的时间,00~59!", 48, "错误提示!")TextBox9.Focus() '重新获取焦点TextBox9.Text = Minute(Now)EndIfEndIfEndSubPrivateSub TextBox10_KeyPress(sender AsObject, e As KeyPressEventArgs) Handles TextBox10.KeyPress Const xStr AsString = "0123456789"e.KeyChar = IIf(InStr(xStr & Chr(8) & Chr(13), e.KeyChar.ToString), e.KeyChar, Nothing) If e.KeyChar = Chr(13) ThenTextBox11.Focus()' Call Command1_Click 回车键事件,这里调用按键1内的单击事件EndIfEndSubPrivateSub TextBox10_LostFocus(sender AsObject, e As EventArgs) Handles TextBox10.LostFocusDim a AsStringa = Val(TextBox10.Text) 'Val'转换为数值型If TextBox10.Text <>""ThenIf a > 9999 Or a < Year(Now) ThenMsgBox("请输入正确的时间,当前年份~9999年!", 48, "错误提示!")TextBox10.Focus() '重新获取焦点TextBox10.Text = Year(Now)EndIfEndIfEndSubPrivateSub TextBox11_KeyPress(sender AsObject, e As KeyPressEventArgs) Handles TextBox11.KeyPress Const xStr AsString = "0123456789"e.KeyChar = IIf(InStr(xStr & Chr(8) & Chr(13), e.KeyChar.ToString), e.KeyChar, Nothing) If e.KeyChar = Chr(13) ThenTextBox12.Focus()' Call Command1_Click 回车键事件,这里调用按键1内的单击事件EndIfEndSubPrivateSub TextBox11_LostFocus(sender AsObject, e As EventArgs) Handles TextBox11.LostFocusDim a AsStringa = Val(TextBox11.Text) 'Val'转换为数值型If TextBox11.Text <>""ThenIf a > 12 Or a <= 0 ThenMsgBox("请输入正确的时间,1~12!", 48, "错误提示!")TextBox11.Focus() '重新获取焦点TextBox11.Text = Month(Now)EndIfEndIfEndSubPrivateSub TextBox12_KeyPress(sender AsObject, e As KeyPressEventArgs) Handles TextBox12.KeyPress Const xStr AsString = "0123456789"e.KeyChar = IIf(InStr(xStr & Chr(8) & Chr(13), e.KeyChar.ToString), e.KeyChar, Nothing) If e.KeyChar = Chr(13) ThenTextBox13.Focus()' Call Command1_Click 回车键事件,这里调用按键1内的单击事件EndIfEndSubPrivateSub TextBox12_LostFocus(sender AsObject, e As EventArgs) Handles TextBox12.LostFocusDim a AsStringDim thisDay AsInteger = DateAndTime.Day(Now)a = Val(TextBox12.Text) 'Val'转换为数值型If TextBox12.Text <>""ThenIf a > 31 Or a <= 0 ThenMsgBox("请输入正确的时间,1~31!", 48, "错误提示!")TextBox12.Focus() '重新获取焦点TextBox12.Text = thisDayEndIfEndIfEndSubPrivateSub TextBox13_KeyPress(sender AsObject, e As KeyPressEventArgs) Handles TextBox13.KeyPress Const xStr AsString = "0123456789"e.KeyChar = IIf(InStr(xStr & Chr(8) & Chr(13), e.KeyChar.ToString), e.KeyChar, Nothing) If e.KeyChar = Chr(13) ThenTextBox14.Focus()' Call Command1_Click 回车键事件,这里调用按键1内的单击事件EndIfEndSubPrivateSub TextBox13_LostFocus(sender AsObject, e As EventArgs) Handles TextBox13.LostFocusDim a AsStringDim thisDay AsInteger = DateAndTime.Day(Now)a = Val(TextBox13.Text) 'Val'转换为数值型If TextBox13.Text <>""ThenIf a > 23 Or a < 0 ThenMsgBox("请输入正确的时间,00~23!", 48, "错误提示!")TextBox13.Focus() '重新获取焦点TextBox13.Text = Hour(Now)EndIfEndIfEndSubPrivateSub TextBox14_KeyPress(sender AsObject, e As KeyPressEventArgs) Handles TextBox14.KeyPress Const xStr AsString = "0123456789"e.KeyChar = IIf(InStr(xStr & Chr(8) & Chr(13), e.KeyChar.ToString), e.KeyChar, Nothing)If e.KeyChar = Chr(13) ThenButton6.Focus()' Call Command1_Click 回车键事件,这里调用按键1内的单击事件EndIfEndSubPrivateSub TextBox14_LostFocus(sender AsObject, e As EventArgs) Handles TextBox14.LostFocus Dim a AsStringDim thisDay AsInteger = DateAndTime.Day(Now)a = Val(TextBox14.Text) 'Val'转换为数值型If TextBox14.Text <>""ThenIf a > 59 Or a <= 0 ThenMsgBox("请输入正确的时间,00~59!", 48, "错误提示!")TextBox14.Focus() '重新获取焦点TextBox14.Text = Minute(Now)EndIfEndIfEndSubEndClass。
VB编程中的精确计时及定时
VB高精度计时器编程在很多场合下编程（例如工业控制、游戏）中需要比较精确的记时器，本文讨论的是在VB下实现记时器的若干方法以及它们的精度控制问题。
在VB中最常用的是Timer 控件，理论上它的记时精度可以达到1ms(毫秒)。
但实际上Timer控件的计时精度无法保证，对于1s的定时事件，也往往会出现50ms以上的计时误差，这对于脉冲信号的采样是不能容忍的。
它只适用于对于精度要求不太高的场合。
这里介绍的是两中利用Windows API函数实现精确记时的方法。
一高性能频率记数法利用这种方法要使用两个API函数QueryPerformanceFrequency和QueryPerformanceCounter。
1、QueryPerformanceFrequency(Frequency)函数其调用格式为：QueryPerformanceFrequency(Frequency) ，调用该函数之后将计算机内部系统定时器的时钟频率存放于变量Frequency中，在VB语言中，可将Frequency定义为Currency类型。
所获取频率值的单位为：HZ函数调用成功后返回非0值，如果安装的硬件不支持高精度计时器，返回02、QueryPerformanceCounter(Counter)函数其调用格式为QueryPerformanceCounter(Counter)，调用函数之后，将计算机内部系统定时器的时钟计数值存放于变量Counter中，在VB语言中，可将Counter定义为Currency 类型。
所获取计数值的单位为：个函数调用成功后返回非,0值，如果安装的硬件不支持高精度计时器，返回0分别调用两次QueryPerformanceCounter()函数，并利用两次获得的计数之差除以调用QueryPerformanceFrequency(Frequency)函数所获取的时钟频率，就可以精确计算出两次计数所经过的时间，单位为秒，可以精确到微秒级。
VB程序代码(简单小程序)
实验一：（带有进度条的倒计时程序）Public Class Form1Dim timers As IntegerDim temp As IntegerPrivate Sub Timer1_Tick(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Timer1.TickIf (ProgressBar1.Value + ProgressBar1.Maximum / timers < ProgressBar1.Maximum) Then ProgressBar1.Value += ProgressBar1.Maximum / timersElseTimer1.Enabled = FalseProgressBar1.Value = ProgressBar1.MaximumMessageBox.Show("进度完成！")End Iftemp += 1Label1.Text = temp.ToString()End SubPrivate Sub Form1_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Loadtimers = 30End SubPrivate Sub Button2_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button2.Clicktimers = Val(InputBox("输入", "请输入总时间。
", 30, 0, 0))End SubPrivate Sub Button1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button1.ClickTimer1.Enabled = TrueEnd SubEnd Class实验二（定时器控制蝴蝶飞舞）Public Class Form1Dim t As IntegerPrivate Sub Timer1_Tick(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Timer1.Tick’Dim t As Boolean' If t = True Then' PictureBox3.Image = PictureBox2.Image' t = False'Else' PictureBox3.Image = PictureBox1.Image' t = True'End IfSelect Case tCase 0PictureBox3.Image = PictureBox1.Imaget = 1Case 1PictureBox3.Image = PictureBox2.Imaget = 2Case 2PictureBox3.Image = PictureBox1.Imaget = 3Case 3PictureBox3.Image = PictureBox1.Imaget = 0End SelectEnd SubEnd Class实验三（递推法迭代法--猴子吃桃）Public Class Form1Private Sub Button1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button1.ClickDim n, y As Integern = Val(TextBox1.Text)y = Val(TextBox2.Text)Dim xi As Doublexi = yTextBox3.Text = "第" + n.ToString() + "天的桃子为：" + y.ToString() + "个。
VB计时器源代码
Dim day, year, month, ddate, ttime As String '定义时间变量Dim alf(0 To 11) '定义数组Dim rr '定义变量Dim ss, hh, mmDim i As IntegerDim nHourLen, nMinLen, nSecLen As Integer '定义时针，分针，秒针长度变量Const Pi = 3.1415926 '定义pi常亮Dim nWidth, alfsec, alfmin, alfhour As IntegerOption ExplicitPrivate Sub Form_Load()Timer1.Interval = 1000 '设置计时器每隔一秒变换一次End SubPrivate Sub Timer1_Timer()rr = PicTime.Height / 2ddate = Format(Now, "mm:dd:yy") '格式化日期变量ttime = Format(Now, "hh:mm:ss") '格式化时间变量month = Left(ddate, 2) '读取月day = Mid(ddate, 4, 2) '读取年year = Right(ddate, 2) '读取日ss = Right(ttime, 2) '读取秒hh = Left(ttime, 2) '读取时针值mm = Mid(ttime, 4, 2) '读取分TxtYear.Text = "20" & year '读取年份TxtMth.Text = month '读取月份TxtDay.Text = day '读取几号LblTime.Caption = Time '显示当前事件值nWidth = PicTime.Width - 40 '设置表盘半径nHourLen = nWidth * 4 / 18 '设置时针半径nMinLen = nWidth * 6 / 18 '设置分针半径nSecLen = nWidth * 8 / 18 '设置秒针半径alfsec = ((ss - 15) / 30) * Pi '设置秒针每次转动的角度alfmin = ((mm + ss / 60 - 15) / 30) * Pi '设置分针每次转动的角度alfhour = ((hh + mm / 60 + ss / 3600 - 15) / 6) * Pi '设置时针每次转动的角度PicTime.RefreshFor i = 0 To 11 '利用循环开始绘制表盘上的刻度alf(i) = i * 30 * Pi / 180PicTime.DrawWidth = 1If i = 0 Or i = 3 Or i = 6 Or i = 9 ThenPicTime.DrawWidth = 3End IfPicTime.Line (rr + (rr - 100) * Cos(alf(i)), rr + (rr - 100) * Sin(alf(i)))-(rr + (rr - 300) * Cos(alf(i)), rr + (rr - 300) * Sin(alf(i))), RGB(25, 25, 25)Next iPicTime.DrawWidth = 3 '设置时针宽度PicTime.Line (rr, rr)-(rr + nHourLen * Cos(alfhour), rr + nHourLen * Sin(alfhour)) '绘制时针PicTime.DrawWidth = 2 '设置分针宽度PicTime.Line (rr, rr)-(rr + nMinLen * Cos(alfmin), rr + nMinLen * Sin(alfmin)) '绘制分针PicTime.DrawWidth = 1PicTime.Line (rr, rr)-(rr + nSecLen * Cos(alfsec), rr + nSecLen * Sin(alfsec))PicTime.DrawWidth = 5 '设置中心点大小PicTime.PSet (rr, rr), RGB(255, 0, 255) '绘制中心点End Sub。
如何在VB程序中设计一个倒计时器
如何在VB程序中设计一个倒计时器
一、介绍
倒计时器是指当事件发生后，计算从该事件起至其中一预定时刻的倒
推时间，有许多应用。
例如，在大型体育活动中，要实现对比赛的倒计时，可以帮助参赛者和观众对赛事的进展情况进行掌握，从而获得一个良好的
比赛体验。
本文将讲述如何在VB程序中设计一个倒计时器，可以帮助用
户进行计时管理，便于相关的任务安排和管理。
二、倒计时器的设计
1、设计倒计时器的界面
在程序的设计过程中，需要设计一个能够展示倒计时剩余的时间数的
界面，比如可以使用Label或者TextBox控件来表现出相关的倒计时信息，这样可以更好的为用户提供便捷的操作流程，比如：
Private Sub Form_Load
'设置初始倒计时的时间
Text1.Text=1200
End Sub
2、编写倒计时器的逻辑
在程序的设计过程中，需要编写出一个能够控制倒计时的逻辑，具体
的就是要在每一段时间内使用Timer控件每次减1，直至倒计时的时间等
于0，这样就可以达到倒计时的效果，比如：
Private Sub Timer1_Timer
'每次减1
Text1.Text=Text1.Text-1
'当倒计时为0时提示
If Text1.Text = 0 Then
MsgBox "时间到！"
'停止计时器
Timer1.Enabled = False
End If
End Sub
三、总结
以上就是如何在VB程序中设计一个倒计时器的基本设计过程。
VB倒计时代码发出BEEP声音
VB倒计时代码发出BEEP声音自己定义时间 10分钟 5分钟或者其它整数时间不超过一小时二个文本框T1，T2,T1用来设定时间的，T2用来显示时间。
二个按钮C1,C2，C1用来启动计时，C2停止并可以重新设置时间，还要画一个计时器用于计时用Private Sub C1_Click()If T1.Text = "" ThenMsgBox "请重新输入", vbCriticalElseT1.Enabled = FalseTr1.Enabled = TrueT2.Text = 0End IfEnd SubPrivate Sub C2_Click()T1.Enabled = TrueTr1.Enabled = FalseT2.Text = 0End SubPrivate Sub Tr1_Timer()If T2.Text = T1.Text ThenBeepTr1.Enabled = FalseMsgBox "时间到", vbOKOnlyT2.Text = 0Else: T2.Text = T2.T ext + 1End IfEnd SubPublic JSjs As Integer '计时时间Public date1 As String '起始时间Private Sub Command6_Click()Timer1.Enabled = Truedate1 = ""End SubPrivate Sub Form_Load()Timer1.Enabled = FalseJSjs = 10 '计时10分钟End SubPrivate Sub Timer1_Timer()If date1 = "" Thendate1 = Format(Now, "yyyy-MM-dd hh:mm:ss") End IfIf DateDiff("n", date1, Now) >= JSjs Then MsgBox "时间到"Timer1.Enabled = FalseEnd IfEnd Sub。
vb制造倒计时程序
vb制造倒计时程序这个是一个制作一个倒计时程序的代码。
程序运行时，始终位于在任何窗口的最前面，双击窗体结束应用程序。
程序运行结果如图54-1所示。
可以在窗体上单击鼠标右键，在弹出的菜单中选择“设置倒计时”，设置界面如图54-2所示。
图54-1 运行结果图54-2 设置倒计时界面技术要点●保持窗体最前●倒计时●TimeSerial ()函数●SetWindowPos（）API函数实现过程■新建项目打开Visual ，选择“新建项目”，在项目类型窗口中选择“Visual Basic项目”，在模板窗口中选择“Windows应用程序”，在名称域中输入“ReverseCount”，然后选择保存路径。
单击“确认”。
■添加控件、菜单和窗体为当前窗体添加两个Label控件和两个Timer控件。
其中一个Timer控件控制一个Label 控件在上方一直循环移动；另一个Timer控件控制时间的显示。
添加一个ContextMenu控件并新建菜单“设置倒计时”和“退出”。
利用菜单“项目|添加Windows窗体”，为当前项目添加一个窗体Form2，给Form2添加四个Label控件，用于说明之用；两个Button按钮和三个TextBox控件。
最后通过菜单“项目|添加模块”为当前项目添加一个模块。
■设置属性切换到“属性栏”，对窗体及窗体上的控件进行设置属性。
详细情况如表54-1和表54-2所示。
窗体Form1及控件的属性值窗体Form2及控件的属性值添加代码Module Module1' 这是在模块中添加的代码Public hours As ShortPublic minutes As ShortPublic seconds As ShortPublic revtime As Date'此API函数用来使某个窗口位于所有窗口之上Public Declare Function SetWindowPos Lib "user32" (ByVal hwnd As Integer, ByValhWndInsertAfter As Integer, ByVal X As Integer, ByVal Y As Integer, ByVal cx AsInteger, ByVal cy As Integer, ByVal wFlags As Integer) As IntegerEnd Module' 下面这些代码是在窗体Form1中添加的' 双及窗体，结束应用程序Private Sub Form1_DoubleClick(ByVal eventSender As System.Object, ByVal eventArgs As System.EventArgs) Handles MyBase.DoubleClickMe.Close()End Sub' 启动程序时，使程序位于任何窗体的上方Private Sub Form1_Load(ByVal eventSender As System.Object, ByVal eventArgs AsSystem.EventArgs) Handles MyBase.LoadMe.TopMost = TrueEnd Sub' 开始倒计时，并显示出来Private Sub Timer1_Tick(ByVal eventSender As System.Object, ByVal eventArgs AsSystem.EventArgs) Handles Timer1.Tickrevtime = DateAdd(Microsoft.VisualBasic.DateInterval.Second, -1, revtime)Label2.Text = Format(revtime, "hh") & ":" & Format(revtime, "mm") & ":" & Format(revtime, "ss")End SubPrivate Sub MenuItem1_Click(ByVal sender As Object, ByVal e As System.EventArgs) Handles MenuItem1.ClickForm2.DefInstance.ShowDialog()End SubPrivate Sub MenuItem2_Click(ByVal sender As Object, ByVal e As System.EventArgs) Handles MenuItem2.ClickMe.Close()End Sub' 下面这些代码是在窗体Form2中添加的Private Sub Button1_Click(ByVal eventSender As System.Object, ByVal eventArgs As System.EventArgs) Handles Button1.Clickhours = Val(Text1.Text)minutes = Val(Text2.Text)seconds = Val(Text3.Text)' 将输入转化为时间格式revtime = TimeSerial(hours, minutes, seconds)bel2.Text = Format(revtime, "hh") & ":" & Format(revtime,"mm") & ":" & Format(revtime, "ss")Form1.DefInstance.Timer1.Enabled = TrueForm2.DefInstance.Hide()End SubPrivate Sub Button2_Click(ByVal eventSender As System.Object, ByVal eventArgs AsSystem.EventArgs) Handles Button2.ClickMe.Close()End Sub运行程序单击菜单“调试|启动”或单击图标运行程序。
vb倒计时源程序代码
Module Module1Sub Main()Dim a As DateDim h, m, s As IntegerDim n, i As LongDim x, z As LongDim y As LongConsole.WriteLine("本程序为倒计时程序，请分部输入需要倒数的小时数、分钟数、秒数")Console.WriteLine("请输入计时的小时数（大于等于0的整数）：")h = Console.ReadLine()Console.WriteLine("请输入计时的总分钟数（大于等于0并且小于60的整数）：")m = Console.ReadLine()Console.WriteLine("请输入计时的秒数（大于等于0的并且小于60的整数）：")s = Console.ReadLine()Console.WriteLine("当前系统时间为：{0}", h)a = Now()Console.WriteLine("当前系统时间为：{0}", a)Console.WriteLine("")Console.WriteLine(" **************倒计时开始***************** ")Console.WriteLine(" **************倒计时开始***************** ")Console.WriteLine(" **************倒计时开始***************** ")Console.WriteLine(" **************倒计时开始***************** ")z = 0x = 60For i = 0 To h * 3600 + m * 60 + sFor n = 0 To 6000000For y = 0 To 25z = z + 1NextNextIf (h <= 0) And (m <= 0) And (s <= 0) Then Exit ForIf s > 0 Thens = s - 1Console.WriteLine(" 剩余：{0}小时{1}分{2}秒", h, m, s)If (h <= 0) And (m <= 0) And (s <= 0) ThenConsole.WriteLine("倒计时完毕，随意输入字符将退出程序：")Exit ForEnd IfEnd IfIf s = 0 ThenIf m > 0 Thenm = m - 1s = 59Console.WriteLine(" 剩余：{0}小时{1}分{2}秒", h, m, s)End IfIf m = 0 And h > 0 And s = 0 Thenh = h - 1m = 59s = 59Console.WriteLine(" 剩余：{0}小时{1}分{2}秒", h, m, s)If (h <= 0) And (m <= 0) And (s <= 0) ThenConsole.WriteLine("倒计时完毕，随意输入字符将退出程序：")Exit ForEnd IfEnd IfEnd IfNextConsole.Read()End Sub End Module。
一个用VB编写的倒计时程序
代码如下：
Dim n As Integer Dim t As String
Private Sub Command1_Click() If Text1.Text = "" Then Exit Sub End If
'计时开始
t = Val(Text1.Text) Timer1.Enabled = True Label1.Caption = "剩余时间：" & t & "分钟"
End If
End Sub
Private Sub Timer2_Timer() Label2.Caption = "现在时间：" & Time
End Sub 运行效果如下图
End Sub
Private Sub Command2_Click() End
End Sub
'退出程序
Private Sub Timer1_Timer() n=n+1 Label1.Caption = "剩余时间：" & t - n & "分钟"
If n = t Then Beep MsgBox "时间到", vbExclamation + vbOKOnly Timer1.Enabled = False n=0
程序的窗体内含有两个timer控件一个文本框控件两个命令按钮控件四个标签控件
一个用 VB编写的倒计时程序
程序的窗体内含有两个Timer控件，一个文本框控件，两个命令按钮控件，四个标签控件。其中Timer1的Interval属性设置为 60000，也就是一分钟响应一次，Timer1的Interval属性设置为500，也就是每0.5秒响应一次。Label1显示剩余时间，Label2
VB编辑时钟控件+倒计时+闹钟+背景图片+背景音乐
Private Sub Check1_Click()WindowsMediaPlayer1.Controls.pauseEnd SubPrivate Sub Check2_Click()WindowsMediaPlayer1.Controls.playEnd SubPrivate Sub Check3_Click()WindowsMediaPlayer1.Controls.stopEnd SubPrivate Sub Command1_Click()Timer1.Interval = 1000Timer1.Enabled = TrueEnd SubPrivate Sub Command2_Click()Timer2.Enabled = TrueTimer2.Interval = 1000End SubPrivate Sub Form_Load()Picture1.Picture = LoadPicture(App.Path & "\images\" & "tp1.jpg") End SubPrivate Sub Timer1_Timer()Static X!, Y!, Z!, a%, b%, c%, q%, w%, E%Const n = 3.141592653Command1.Visible = FalsePicture1.ClsPicture1.Scale (-1000, 1000)-(1000, -1000)Picture1.Circle (0, 0), 900Dim l As DoubleDim r As DoubleFor i = 0 To 60l = (1 - Sin(i / 60 * 2 * 3.1415926)) * 900 - 900r = (1 - Cos(i / 60 * 2 * 3.1415926)) * 900 - 900Picture1.DrawWidth = 3Picture1.PSet (l, r)Picture1.DrawWidth = 4Next iPicture1.PSet (0, 0)Picture1.CurrentX = -100: Picture1.CurrentY = 850Picture1.FontSize = 25Picture1.Print "12"Picture1.CurrentX = -40: Picture1.CurrentY = -690Picture1.Print "6"Picture1.CurrentX = -850: Picture1.CurrentY = 80Picture1.Print "9"Picture1.CurrentX = 700: Picture1.CurrentY = 100Picture1.Print "3"Picture1.FontSize = 18Picture1.CurrentX = 360: Picture1.CurrentY = 740Picture1.Print "1"Picture1.CurrentX = 650: Picture1.CurrentY = 450Picture1.Print "2"Picture1.CurrentX = 630: Picture1.CurrentY = -320Picture1.Print "4"Picture1.CurrentX = 360: Picture1.CurrentY = -600Picture1.Print "5"Picture1.CurrentX = -430: Picture1.CurrentY = 740Picture1.Print "11"Picture1.CurrentX = -750: Picture1.CurrentY = 440Picture1.Print "10"Picture1.CurrentX = -700: Picture1.CurrentY = -360Picture1.Print "8"Picture1.CurrentX = -370: Picture1.CurrentY = -610Picture1.Print "7"Picture1.DrawWidth = 1X = Second(Time) * 2 * n / 60Y = Minute(Time) * 2 * n / 60Z = Hour(Time) * 2 * n / 12Picture1.Line (0, 0)-(800 * Sin(X), 800 * Cos(X))Picture1.Circle (700 * Sin(X), 700 * Cos(X)), 50Picture1.Line (0, 0)-(600 * Sin(Y), 600 * Cos(Y)), QBColor(5)Picture1.Line (0, 0)-(400 * Sin(Z), 400 * Cos(Z)), QBColor(12)h = Year(Now)i = Month(Now)j = Day(Now)k = Hour(Now)l = Minute(Now)m = Second(Now)Label10.Caption = h & "-" & i & "-" & jLabel11.Caption = k & ":" & l & ":" & mu = Weekday(Now)Select Case uCase 1Label8.Caption = "一"Case 2Label8.Caption = "二"Case 3Label8.Caption = "三"Case 4Label8.Caption = "四"Case 5Label8.Caption = "五"Case 6Label8.Caption = "六"Case 7Label8.Caption = "日"End SelectEnd SubPrivate Sub Timer2_Timer()Dim z1, z2, z3, z4, z5, z6, z7, z8, z9, z10%z1 = V al(Text1.Text)z2 = V al(Text2.Text)z3 = V al(Text3.Text)z4 = V al(Text4.Text)z5 = V al(Text5.Text)z6 = V al(Text6.Text)date1 = DateSerial(z1, z2, z3)date2 = DateSerial(Year(Now), Month(Now), Day(Now))z7 = DateDiff("d", date2, date1)time1 = TimeSerial(z4, z5, z6)time2 = TimeSerial(Hour(Now), Minute(Now), Second(Now)) z8 = DateDiff("h", time2, time1)z9 = DateDiff("n", time2, time1) - z8 * 60z10 = DateDiff("s", time2, time1) - z9 * 60 - z8 * 3600If z2 > 12 Or z3 > 31 Or z4 > 23 Or z5 > 59 Or z6 > 59 Then q = MsgBox("输入有误，请重新输入", , "出错")Print qEnd IfIf z10 < 0 Thenz9 = z9 - 1z10 = 60 + z10End IfIf z9 < 0 Thenz8 = z8 - 1z9 = 60 + z9End IfIf z8 < 0 Thenz7 = z7 - 1z8 = 24 + z8End IfLabel14.Caption = z7 & "天" & z8 & "小时" & z9 & "分" & z10 & "秒"If z7 = 0 And z8 = 0 And z9 = 0 And z10 = 0 ThenMsgBox "时间到", , "倒计时"WindowsMediaPlayer1.URL = App.Path & "\music\" & "dd.mp3" Timer2.Enabled = FalseEnd IfEnd SubPrivate Sub tp1_Click()Picture1.Picture = LoadPicture(App.Path & "\images\" & "tp6.jpg") End SubPrivate Sub tp2_Click()Picture1.Picture = LoadPicture(App.Path & "\images\" & "tp2.jpg") End SubPrivate Sub tp3_Click()Picture1.Picture = LoadPicture(App.Path & "\images\" & "tp3.jpg") End SubPrivate Sub tp4_Click()Picture1.Picture = LoadPicture(App.Path & "\images\" & "tp4.jpg") End SubPrivate Sub tp5_Click()Picture1.Picture = LoadPicture(App.Path & "\images\" & "tp5.jpg") End SubPrivate Sub yy1_Click()WindowsMediaPlayer1.URL = App.Path & "\music\" & "He's a Pirate.mp3" End SubPrivate Sub yy2_Click()WindowsMediaPlayer1.URL = App.Path & "\music\" & "apologize.mp3" End SubPrivate Sub yy3_Click()WindowsMediaPlayer1.URL = App.Path & "\music\" & "Heartbeats.mp3" End Sub。
在VB类模块中使用计时器
在VB类模块中使用计时器'一、类模块代码如下：'VB codeOption Explicit'* ******************************************** *'* 模块名称：Timer.cls'* 功能：在VB类模块中使用计时器'* 作者：lyserver'* ******************************************** *Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, _Source As Any, ByVal Length As Long)Private Declare Function SetTimer Lib "user32" (ByVal hwnd As Long, ByVal nIDEvent As Long, _ByVal uElapse As Long, ByVal lpTimerFunc As Long) As Long Private Declare Function KillTimer Lib "user32" (ByVal hwnd As Long, ByVal nIDEvent As Long) As LongDim m_idTimer As LongDim m_Enabled As BooleanDim m_Interval As LongPrivate Sub Class_Initialize()m_Interval = 0End SubPrivate Sub Class_T erminate()If m_idTimer <> 0 Then KillTimer 0, m_idTimerEnd SubPublic Property Get Interval() As LongInterval = m_IntervalEnd PropertyPublic Property Let Interval(ByVal New_Value As Long)If New_Value >= 0 Then m_Interval = New_ValueEnd PropertyPublic Property Get Enabled() As BooleanEnabled = m_EnabledEnd PropertyPublic Property Let Enabled(ByVal New_Value As Boolean)m_Enabled = New_ValueIf m_idTimer <> 0 Then KillTimer 0, m_idTimerIf New_Value And m_Interval > 0 Thenm_idTimer = SetTimer(0, 0, m_Interval, GetFuncAddr(8))End IfEnd PropertyPrivate Function GetFuncAddr(ByVal IndexOfFunc As Long) As LongStatic AsmCode(33) As ByteDim pThis As Long, pVtbl As Long, pFunc As LongpThis = ObjPtr(Me)CopyMemory pVtbl, ByVal pThis, 4CopyMemory pFunc, ByVal pVtbl + (6 + IndexOfFunc) * 4, 4 AsmCode(0) = &H55AsmCode(1) = &H8B: AsmCode(2) = &HECCopyMemory AsmCode(3), &H1475FF, 3CopyMemory AsmCode(6), &H1075FF, 3CopyMemory AsmCode(9), &HC75FF, 3CopyMemory AsmCode(12), &H875FF, 3AsmCode(15) = &HB9CopyMemory AsmCode(16), pThis, 4AsmCode(20) = &H51AsmCode(21) = &HE8CopyMemory AsmCode(22), pFunc - VarPtr(AsmCode(21)) - 5, 4AsmCode(26) = &H8B: AsmCode(27) = &HE5AsmCode(28) = &H5DAsmCode(29) = &HC2CopyMemory AsmCode(30), 16, 4GetFuncAddr = VarPtr(AsmCode(0))End FunctionPrivate Sub TimerProc(ByVal hwnd As Long, ByVal uMsg As Long, ByVal idEvent As Long, ByVal dwTime As Long) Debug.Print "类模板中的计时器：", uMsg, idEvent, dwTimeEnd Sub'二、调用代码如下：'VB codeDim m_tm As TimerPrivate Sub Form_Load()Set m_tm = New TimerEnd SubPrivate Sub Form_Unload(Cancel As Integer)Set m_tm = NothingEnd SubPrivate Sub Command1_Click()m_tm.Interval = 1000m_tm.Enabled = TrueEnd SubPrivate Sub Command2_Click()m_tm.Enabled = FalseEnd Sub。
计时器控件在VB中的应用
计时器控件在VB中的应用计时器控件在工具箱中的名称是Timer，该控件是一个非可视控件，即在运行时不可见，用于实现每隔一定时间间隔执行指定的操作。
Timer控件对于其他后台处理也是非常有用的。
本文用实例来介绍在VB程序中利用计时器控件，实现在程序在启动运行期间各种不同的效果。
下面给出编程设计过程，供读者参考选用。
一、计时器（Timer）控件与标签(Label)控件的应用1、启动VB，新建工程。
在工程中添加一个窗体Form1，在窗体上加入一个Timer 计时器控件Timer1和标签控件Label12、编写相应的代码，实现不同的功能（1）字体颜色发生随机变化的效果，计时器事件（Timer）代码如下：l 窗体Form1的加载事件代码Private Sub Form_Load()Timer1.interval=500Label1.Caption = “欢迎进入VB应用程序”Label1.font.size=20Label1.autosize=trueEnd Subl 计时器（Timer1）控件的Timer事件代码Private Sub Timer1_Timer()Label1.ForeColor = RGB(255 * Rnd, 255 * Rnd, 255 * Rnd)End Sub（2）依次出现字幕的实现效果，相关事件代码如下：Dim i …在通用-声明中定义变量…Private Sub Timer1_Timer()i = i + 1Label1.Caption = Left(“欢迎进入VB应用程序”, i)If i > 10 Theni = 0End IfEnd Sub（3）滚动字幕的实现效果，相关事件代码如下：l 窗体Form1的加载事件代码Private Sub Form_Load()Label1.Caption = “欢迎进入VB应用程序”End Subl 计时器（Timer1）控件的Timer事件代码Private Sub Timer1_Timer()If Label1.Left <= Form1.Width ThenLabel1.Left = Label1.Left + 100ElseLabel1.Left = -Label1.WidthEnd IfEnd Sub（4）制作字体闪烁的效果l 在窗体上添加一个计时器控件：Timer1和两个标签控件：Label1、Label2，l 在工具菜单中添加过程：Chc ，其相关代码如下：Sub Chc(Cont As Control, Color1 As Integer, Color2 As Integer, Color3 As Integer, Color4 As Integer, Color5 As Integer, Color6 As Integer, Color7 As Integer) If Val(Cont.Tag) = Color1 ThenCont.Tag = Color2ElseIf Val(Cont.Tag) = Color2 ThenCont.Tag = Color3ElseIf Val(Cont.Tag) = Color3 ThenCont.Tag = Color4ElseIf Val(Cont.Tag) = Color4 ThenCont.Tag = Color5ElseIf Val(Cont.Tag) = Color5 ThenCont.Tag = Color6ElseIf Val(Cont.Tag) = Color6 ThenCont.Tag = Color7ElseIf Val(Cont.Tag) = Color7 ThenCont.Tag = Color1ElseCont.Tag = Color1End IfCont.ForeColor = QBColor(Cont.Tag)End Subl 窗体的加载事件代码：Private Sub Form_Load()Label1.Caption = “欢迎进入梦想家园” = “华文彩云”Label1.Font.Size = 30Label1.AutoSize = TrueTimer1.Interval = 100End Subl Label2的单击事件代码如下：Private Sub Label2_Click()If Timer1.Enabled = True ThenTimer1.Enabled = FalseLabel2.Caption = “开始闪烁”ElseLabel2.Caption = “停止闪烁”Timer1.Enabled = TrueEnd IfEnd Subl 计时器（Timer）控件的Timer事件代码如下：Private Sub Timer1_Timer()Chc Label1, 1, 3, 5, 8, 10, 12, 14End Sub二、计时器（Timer）控件与进度条(ProgressBar)控件的应用1、启动VB，新建工程。
VB多功能计时器代码
frmTimer窗体控件：commandbutton * 2 picturebox * 1 pictureclip(注：图片剪切控件) * 1 timer * 3（注：此处只给出了控件类型，控件名祥见代码）frmTimer 的代码Option ExplicitPublic t As Integer, str As StringPublic h As Integer, m As Integer, s As IntegerPrivate Sub Show_LED(picTimer As PictureBox, str As String)'显示图片的通用过程Dim s As String * 1Dim pos As IntegerDim n As IntegerDim i As IntegerFor i = 1 To Len(str)s = Mid(str, i, 1)n = -1Select Case sCase "0" To "9"n = CInt(s)Case ":"n = 10Case "-"n = 11Case "."n = 12Case "a", "A"n = 13Case "p", "P"n = 14Case " "n = 15End SelectIf n <> -1 ThenpicTimer.PaintPicture PCTimer.GraphicCell(n), pos, 0pos = pos + 300End IfNextEnd SubPrivate Sub cmdRestart_Click() '秒表的回零h = 0m = 0s = 0str = ""cmdStart.Caption = "开始"Timer1.Enabled = False: str = "00:00:00"ClsCall Show_LED(picTimer, str)End SubPrivate Sub cmdStart_Click() '秒表的开始和暂停控制If cmdStart.Caption = "开始" Thenh = 0m = 0s = 0cmdStart.Caption = "暂停"Timer1.Enabled = TruecmdRestart.Enabled = FalseExit SubElseIf cmdStart.Caption = "暂停" ThencmdStart.Caption = "继续"Timer1.Enabled = FalsecmdRestart.Enabled = TrueExit SubElsecmdStart.Caption = "暂停"Timer1.Enabled = TruecmdRestart.Enabled = FalseExit SubEnd IfEnd SubPrivate Sub Form_Load() '窗体加载Call mnuClock_ClickEnd SubPrivate Sub mnuClock_Click() '时钟picTimer.ClsMe.ClsTimer1.Enabled = FalseTimer2.Enabled = False cmdStart.Visible = FalsecmdRestart.Visible = FalsefrmTimer.Caption = "时钟"Timer3.Enabled = TruepicTimer.Visible = TrueClsEnd SubPrivate Sub mnuCuntDwnClock_Click() '倒计时picTimer.ClsMe.ClsTimer1.Enabled = FalseTimer3.Enabled = FalsecmdStart.Visible = FalsecmdRestart.Visible = FalsefrmSet.Visible = TruefrmTimer.Caption = "倒计时钟" picTimer.Visible = TrueEnd SubPrivate Sub mnuExit_Click() '退出选项Unload frmTimer: Unload frmSetEnd SubPrivate Sub mnuStopwatch_Click() '秒表picTimer.ClsMe.ClsTimer1.Enabled = FalseTimer2.Enabled = FalseTimer3.Enabled = FalsecmdStart.Visible = TruecmdRestart.Visible = TruefrmTimer.Caption = "秒表"picTimer.Visible = TrueEnd SubPrivate Sub Timer1_Timer() '秒表计时过程str = ""s = s + 1If s = 100 Then '秒表数字显示的处理s = 0m = m + 1If m = 60 Thenm = 0h = h + 1If h = 24 Thenh = 0End IfEnd IfEnd IfIf h < 10 Then '数字显示格式的处理str = str & 0 & hElse: str = str & hEnd IfIf m < 10 Thenstr = str & ":" & 0 & mElse: str = str & ":" & mEnd IfIf s < 10 Thenstr = str & ":" & 0 & sElse: str = str & ":" & sEnd IfClsCall Show_LED(picTimer, str)End SubPrivate Sub Timer2_Timer() '倒计时计时过程picTimer.Clsstr = ""t = h * 3600 + m * 60 + sIf t >= 1 Thens = s - 1If s = -1 Thens = 59m = m - 1End IfIf m = -1 Thenm = 59h = h - 1End IfIf h < 10 Thenstr = str & "0" & hElsestr = str & ":" & hEnd IfIf m < 10 Thenstr = str & ":" & "0" & m Elsestr = str & ":" & mEnd IfIf s < 10 Thenstr = str & ":" & "0" & sElsestr = str & ":" & sEnd IfClsCall Show_LED(picTimer, str)ElsepicTimer.Visible = FalseClsfrmTimer.Print "时间到"Timer2.Enabled = FalseEnd IfEnd SubPrivate Sub Timer3_Timer() '时钟显示过程str = CStr(Now)Call Show_LED(picTimer, str)ClsEnd SubfrmTimer窗体控件：text * 3commandbuton * 1label * 3(注：控件名称参照代码)frmSet 的代码Option ExplicitPrivate Sub cmdCuntStart_Click()frmTimer.h = Val(txtInput(0))frmTimer.m = Val(txtInput(1))frmTimer.s = Val(txtInput(2))If frmTimer.h + frmTimer.m + frmTimer.s = 0 ThenCall MsgBox("输入错误，请重新输入", 48, "多功能计时器") ElsefrmTimer.Timer2.Enabled = TrueUnload frmSetEnd IfEnd Sub。
VB.NET多线程实现线程计时器
Threading.Timer类对在单独线程中定期运⾏任务⼗分有⽤。
例如，可以使⽤线程计时器检查数据库的状态和完整性，或者备份重要⽂件。
以下⽰例每两秒钟启动⼀个任务，并使⽤标志来启动使计时器停⽌的Dispose⽅法。
本例将状态发送到输出窗⼝，因此在测试代码之前，加⼊收藏应按CONTROL+ALT+O键以使此窗⼝可见。
ClassStateObjClass'⽤于保留调⽤TimerTask所需的参数 PublicSomeValueAsInteger PublicTimerReferenceAsSystem.Threading.Timer PublicTimerCanceledAsBooleanEndClassSubRunTimer() DimStateObjAsNewStateObjClass() StateObj.TimerCanceled=False StateObj.SomeValue=1 DimTimerDelegateAsNewThreading.TimerCallback(AddressOfTimerTask) '创建每隔2秒钟调⽤过程的计时器。
'注意：这⾥没有Start⽅法；创建实例之后， '计时器就开始运⾏。
DimTimerItemAsNewSystem.Threading.Timer(TimerDelegate,StateObj,_2000,2000) StateObj.TimerReference=TimerItem '为Dispose保存⼀个引⽤。
WhileStateObj.SomeValue<10'运⾏10个循环。
System.Threading.Thread.Sleep(1000) '等待1秒钟。
EndWhile StateObj.TimerCanceled=True '请求计时器对象的Dispose。
- 1、下载文档前请自行甄别文档内容的完整性，平台不提供额外的编辑、内容补充、找答案等附加服务。
- 2、"仅部分预览"的文档,不可在线预览部分如存在完整性等问题,可反馈申请退款(可完整预览的文档不适用该条件!)。
- 3、如文档侵犯您的权益，请联系客服反馈,我们会尽快为您处理(人工客服工作时间：9:00-18:30)。
VB多功能计时器代码frmTimer窗体控件:commandbutton * 2picturebox * 1pictureclip(注:图片剪切控件) * 1timer * 3(注:此处只给出了控件类型，控件名祥见代码)frmTimer 的代码Option ExplicitPublic t As Integer, str As StringPublic h As Integer, m As Integer, s As IntegerPrivate Sub Show_LED(picTimer As PictureBox, str As String) '显示图片的通用过程Dim s As String * 1Dim pos As IntegerDim n As IntegerDim i As IntegerFor i = 1 To Len(str)s = Mid(str, i, 1)n = -1Select Case sCase "0" To "9"n = CInt(s)Case ":"n = 10Case "-"n = 11Case "."n = 12Case "a", "A"n = 13Case "p", "P"n = 14Case " "n = 15End SelectIf n <> -1 ThenpicTimer.PaintPicture PCTimer.GraphicCell(n), pos, 0 pos = pos + 300End IfNextEnd SubPrivate Sub cmdRestart_Click() '秒表的回零h = 0m = 0s = 0str = ""cmdStart.Caption = "开始"Timer1.Enabled = False: str = "00:00:00"ClsCall Show_LED(picTimer, str) End SubPrivate Sub cmdStart_Click() '秒表的开始和暂停控制If cmdStart.Caption = "开始" Thenh = 0m = 0s = 0cmdStart.Caption = "暂停"Timer1.Enabled = TruecmdRestart.Enabled = FalseExit SubElseIf cmdStart.Caption = "暂停" Then cmdStart.Caption = "继续"Timer1.Enabled = FalsecmdRestart.Enabled = TrueExit SubElsecmdStart.Caption = "暂停"Timer1.Enabled = TruecmdRestart.Enabled = FalseExit SubEnd IfEnd SubPrivate Sub Form_Load() '窗体加载Call mnuClock_Click End SubPrivate Sub mnuClock_Click() '时钟picTimer.ClsMe.ClsTimer1.Enabled = FalseTimer2.Enabled = FalsecmdStart.Visible = FalsecmdRestart.Visible = FalsefrmTimer.Caption = "时钟"Timer3.Enabled = TruepicTimer.Visible = TrueClsEnd SubPrivate Sub mnuCuntDwnClock_Click() '倒计时picTimer.ClsMe.ClsTimer1.Enabled = FalseTimer3.Enabled = FalsecmdStart.Visible = FalsecmdRestart.Visible = FalsefrmSet.Visible = TruefrmTimer.Caption = "倒计时钟" picTimer.Visible = True End Sub Private Sub mnuExit_Click() '退出选项Unload frmTimer: Unload frmSetEnd SubPrivate Sub mnuStopwatch_Click() '秒表picTimer.ClsMe.ClsTimer1.Enabled = FalseTimer2.Enabled = FalseTimer3.Enabled = FalsecmdStart.Visible = TruecmdRestart.Visible = TruefrmTimer.Caption = "秒表"picTimer.Visible = True End Sub Private Sub Timer1_Timer() '秒表计时过程str = ""s = s + 1If s = 100 Then '秒表数字显示的处理s = 0m = m + 1If m = 60 Thenm = 0h = h + 1If h = 24 Thenh = 0End IfEnd IfEnd IfIf h < 10 Then '数字显示格式的处理str = str & 0 & hElse: str = str & hEnd IfIf m < 10 Thenstr = str & ":" & 0 & mElse: str = str & ":" & mEnd IfIf s < 10 Thenstr = str & ":" & 0 & sElse: str = str & ":" & sEnd IfClsCall Show_LED(picTimer, str) End Sub Private Sub Timer2_Timer() '倒计时计时过程picTimer.Clsstr = ""t = h * 3600 + m * 60 + sIf t >= 1 Thens = s - 1If s = -1 Thens = 59m = m - 1End IfIf m = -1 Thenm = 59h = h - 1End IfIf h < 10 Thenstr = str & "0" & hElsestr = str & ":" & hEnd IfIf m < 10 Thenstr = str & ":" & "0" & m Elsestr = str & ":" & mEnd IfIf s < 10 Thenstr = str & ":" & "0" & s Elsestr = str & ":" & sEnd IfClsCall Show_LED(picTimer, str)ElsepicTimer.Visible = FalseClsfrmTimer.Print "时间到"Timer2.Enabled = FalseEnd IfEnd SubPrivate Sub Timer3_Timer() '时钟显示过程str = CStr(Now)Call Show_LED(picTimer, str)ClsEnd SubfrmTimer窗体控件:text * 3commandbuton * 1label * 3 (注:控件名称参照代码)frmSet 的代码Option ExplicitPrivate Sub cmdCuntStart_Click() frmTimer.h = Val(txtInput(0)) frmTimer.m = Val(txtInput(1)) frmTimer.s = Val(txtInput(2))If frmTimer.h + frmTimer.m + frmTimer.s = 0 ThenCall MsgBox("输入错误，请重新输入", 48, "多功能计时器") ElsefrmTimer.Timer2.Enabled = TrueUnload frmSetEnd IfEnd Sub。