我以前自已编写的一个倒计时小程序,自已看吧!
Option Explicit
Private Type Two_Time
Minute As Integer
Second As Integer
End Type
Dim Rejion_Total_Time As Two_Time
Dim Question_Total_Time As Two_Time
Dim Question_Time As Two_Time
Dim Rejion_Time As Two_Time
Dim Sign As Boolean
Private Declare Function SetWindowPos Lib "user32" (ByVal hwnd As _
Long, ByVal hWndInsertAfter As Long, ByVal X As Long, ByVal _
Y As Long, ByVal cx As Long, ByVal cy As Long, ByVal _
wFlags As Long) As Long
Const HWND_TOPMOST = -1
Const HWND_TOP = 0
Const SWP_SHOWWINDOW = &H40
Private Sub Form_Load()
Count_Down.Left = Screen.Width - Count_Down.Width
SetWindowPos Count_Down.hwnd, HWND_TOPMOST, Me.Left \ Screen.TwipsPerPixelX, _
Me.Top \ Screen.TwipsPerPixelY, _
Me.Width \ Screen.TwipsPerPixelX, _
Me.Height \ Screen.TwipsPerPixelY, _
SWP_SHOWWINDOW
End Sub
Private Sub Down_Image_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
Up_Image.Visible = True
Down_Image.Visible = False
Count_Down.Height = 2865
End Sub
Private Sub Question_Minute_Txt_LostFocus()
Dim Msg As String
If IsNumeric(Question_Minute_Txt) <> True Then
Msg = MsgBox("请输入数字!", vbOKOnly, "警告!")
Question_Minute_Txt.Text = ""
Question_Minute_Txt.SetFocus
End If
End Sub
Private Sub Question_Second_Txt_LostFocus()
Dim Msg As String
If IsNumeric(Question_Second_Txt) <> True Then
Msg = MsgBox("请输入数字!", vbOKOnly, "警告!")
Question_Second_Txt.Text = ""
Question_Second_Txt.SetFocus
End If
End Sub
Private Sub Rejion_Minute_Txt_LostFocus()
Dim Msg As String
If IsNumeric(Rejion_Minute_Txt) <> True Then
Msg = MsgBox("请输入数字!", vbOKOnly, "警告!")
Rejion_Minute_Txt.Text = ""
Rejion_Minute_Txt.SetFocus
End If
End Sub
Private Sub Rejion_Second_Txt_LostFocus()
Dim Msg As String
If IsNumeric(Rejion_Second_Txt) <> True Then
Msg = MsgBox("请输入数字!", vbOKOnly, "警告!")
Rejion_Second_Txt.Text = ""
Rejion_Second_Txt.SetFocus
End If
End Sub
Private Sub Up_Image_Click()
Up_Image.Visible = False
Down_Image.Visible = True
Count_Down.Height = 800
Count_Down.BorderStyle = 0
Count_Down.Show
End Sub
Private Sub Down_Image_Click()
Up_Image.Visible = True
Down_Image.Visible = False
Count_Down.Height = 2865
End Sub
Private Sub Question_Cmd_Click(Index As Integer)
Dim Msg As String
Select Case Index
Case 0
If Question_Cmd(3).Enabled = False Then
Question_Total_Time.Minute = Question_Time.Minute
Question_Total_Time.Second = Question_Time.Second
Timer1.Enabled = True
Sign = False
Else: Msg = MsgBox("您还没有设定时间!", vbOKOnly, "警告!")
Exit Sub
End If
Case 1
Timer1.Enabled = False
Sign = True
Minute_Label.Caption = "00"
Second_Label.Caption = "00"
Case 2
Question_Minute_Txt.Enabled = True
Question_Second_Txt.Enabled = True
Question_Cmd(3).Enabled = True
Case 3
If CInt(Question_Minute_Txt.Text) <= 60 And CInt(Question_Minute_Txt.Text) >= 0 And CInt(Question_Second_Txt.Text) >= 0 And CInt(Question_Second_Txt.Text) <= 60 Then
Question_Time.Minute = CInt(Question_Minute_Txt.Text)
Question_Time.Second = CInt(Question_Second_Txt.Text)
Question_Total_Time.Minute = Question_Time.Minute
Question_Total_Time.Second = Question_Time.Second
Question_Minute_Txt.Enabled = False
Question_Second_Txt.Enabled = False
Question_Cmd(3).Enabled = False
Else:
Msg = MsgBox("请输入正确的时间!", vbOKOnly, "警告!")
Question_Minute_Txt.Text = ""
Question_Second_Txt.Text = ""
End If
End Select
End Sub
Private Sub Rejion_Cmd_Click(Index As Integer)
Dim Msg As String
Select Case Index
Case 0
If Rejion_Cmd(3).Enabled = False Then
Rejion_Total_Time.Minute = Rejion_Time.Minute
Rejion_Total_Time.Second = Rejion_Time.Second
Timer1.Enabled = True
Sign = True
Else: Msg = MsgBox("您还没有设定时间!", vbOKOnly, "警告!")
Exit Sub
End If
Case 1
Msg = MsgBox("是否开始提问倒计时?", vbYesNo, "询问?")
If Msg = 6 Then
If Question_Cmd(3).Enabled = True Then
Msg = MsgBox("您还没有设定时间!", vbOKOnly, "警告!")
Exit Sub
End If
Sign = False
End If
Minute_Label.Caption = "00"
Second_Label.Caption = "00"
Case 2
Rejion_Minute_Txt.Enabled = True
Rejion_Second_Txt.Enabled = True
Rejion_Cmd(3).Enabled = True
Case 3
If CInt(Rejion_Minute_Txt.Text) <= 60 And CInt(Rejion_Minute_Txt.Text) >= 0 And CInt(Rejion_Second_Txt.Text) >= 0 And CInt(Rejion_Second_Txt.Text) <= 60 Then
Rejion_Time.Minute = CInt(Rejion_Minute_Txt.Text)
Rejion_Time.Second = CInt(Rejion_Second_Txt.Text)
Rejion_Total_Time.Minute = Rejion_Time.Minute
Rejion_Total_Time.Second = Rejion_Time.Second
Rejion_Minute_Txt.Enabled = False
Rejion_Second_Txt.Enabled = False
Rejion_Cmd(3).Enabled = False
Else:
Msg = MsgBox("请输入正确的时间!", vbOKOnly, "警告!")
Rejion_Minute_Txt.Text = ""
Rejion_Second_Txt.Text = ""
End If
End Select
End Sub
Private Sub Timer1_Timer()
Dim Msg As String
Dim ScreenProfect
Select Case Sign
Case True
If Rejion_Total_Time.Minute = 0 And Rejion_Total_Time.Second = 0 Then
Timer1.Enabled = False
Msg = MsgBox("时间到!是否开启提问倒计时?", vbYesNo, "提示!")
If Msg = 6 Then
If Question_Cmd(3).Enabled = True Then
Msg = MsgBox("您还没有设定提问时间!", vbOKOnly, "警告!")
Rejion_Total_Time.Second = Rejion_Total_Time.Second + 1
Else
Question_Total_Time.Minute = Question_Time.Minute
Question_Total_Time.Second = Question_Time.Second
Sign = False
Timer1.Enabled = True
End If
Else
Timer1.Enabled = False
End If
Exit Sub
ElseIf Rejion_Total_Time.Minute <> 0 And Rejion_Total_Time.Second = 0 Then
Rejion_Total_Time.Minute = Rejion_Total_Time.Minute - 1
Rejion_Total_Time.Second = 60
End If
Rejion_Total_Time.Second = Rejion_Total_Time.Second - 1
Minute_Label.Caption = Rejion_Total_Time.Minute
Second_Label.Caption = Rejion_Total_Time.Second
Case False
If Question_Total_Time.Minute = 0 And Question_Total_Time.Second = 0 Then
Timer1.Enabled = False
Beep
FlashForm.Show
' ScreenProfect = Shell("sstext3d.scr /e", 1)
' Msg = MsgBox("提问时间到!", vbOKOnly, "提示!")
Sign = True
Timer1.Enabled = False
Exit Sub
ElseIf Question_Total_Time.Minute <> 0 And Question_Total_Time.Second = 0 Then
Question_Total_Time.Minute = Question_Total_Time.Minute - 1
Question_Total_Time.Second = 60
End If
Question_Total_Time.Second = Question_Total_Time.Second - 1
Minute_Label.Caption = Question_Total_Time.Minute
Second_Label.Caption = Question_Total_Time.Second
End Select
End Sub
Private Sub Up_Image_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
Up_Image.Visible = False
Down_Image.Visible = True
Count_Down.Height = 800
Count_Down.BorderStyle = 0
End Sub