7,785
社区成员




VERSION 5.00
Begin VB.Form Form1
Caption = "Form1"
ClientHeight = 2430
ClientLeft = 60
ClientTop = 345
ClientWidth = 4680
LinkTopic = "Form1"
ScaleHeight = 2430
ScaleWidth = 4680
StartUpPosition = 3 '窗口缺省
Begin VB.CommandButton Command2
Caption = "Start"
Enabled = 0 'False
Height = 495
Left = 2880
TabIndex = 4
Top = 720
Width = 1575
End
Begin VB.CommandButton Command1
Caption = "Stop"
Height = 495
Left = 2880
TabIndex = 3
Top = 1320
Width = 1575
End
Begin VB.TextBox Text1
Height = 270
Left = 2040
TabIndex = 0
Text = "500"
Top = 240
Width = 975
End
Begin VB.Timer Timer2
Interval = 30
Left = 0
Top = 960
End
Begin VB.Timer Timer1
Interval = 20
Left = 0
Top = 1440
End
Begin VB.Label Label3
AutoSize = -1 'True
Caption = "设置一个值,500-60000"
Height = 180
Left = 0
TabIndex = 5
Top = 240
Width = 1800
End
Begin VB.Label Label2
AutoSize = -1 'True
Caption = "Label2"
Height = 180
Left = 480
TabIndex = 2
Top = 960
Width = 540
End
Begin VB.Label Label1
AutoSize = -1 'True
Caption = "Label1"
Height = 180
Left = 480
TabIndex = 1
Top = 1440
Width = 540
End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Dim bStop As Boolean
Dim lCount As Long
Private Sub Command1_Click()
bStop = True
Timer1.Enabled = False
Timer2.Enabled = False
Command1.Enabled = False
Command2.Enabled = True
End Sub
Private Sub Command2_Click()
bStop = False
Timer1.Enabled = True
Timer2.Enabled = True
Command1.Enabled = True
Command2.Enabled = False
End Sub
Private Sub Form_Load()
lCount = Val(Text1.Text)
End Sub
Private Sub Text1_Change()
If Not bStop Then
MsgBox "先停止那两个计时器"
Else
lCount = Val(Text1.Text)
End If
End Sub
Private Sub Timer1_Timer()
Dim i, j, k, l
k = Timer
For i = 1 To lCount
For j = 1 To lCount
l = j
If bStop Then Exit Sub
DoEvents
Next j
Next i
Label1.Caption = Timer & " " & Timer - k
End Sub
Private Sub Timer2_Timer()
Dim i, j, k, l
k = Timer
For i = 1 To lCount
For j = 1 To lCount
l = j
If bStop Then Exit Sub
DoEvents
Next j
Next i
Label2.Caption = Timer & " " & Timer - k
End Sub
'This project requires a Form and a Module
'On the form, there should be one command button (Command1)
'and one Timer (Timer1)
'In the form:
Option Explicit
Private Sub Form_Load()
'KPD-Team 2001
'URL: http://www.allapi.net/
'E-Mail: KPDTeam@Allapi.net
Command1.Caption = "Start"
End Sub
Private Sub Form_Unload(Cancel As Integer)
'Stop the timers if they're still counting
timeKillEvent hMMTimer
Timer1.Enabled = False
End Sub
Private Sub Timer1_Timer()
'increment VBTimer
VBTimer = VBTimer + 1
End Sub
Private Sub Command1_Click()
If Command1.Caption = "Start" Then
'Start both timers
Timer1.Interval = 1
Timer1.Enabled = True
hMMTimer = timeSetEvent(1, 0, AddressOf TimerProc, 0, TIME_PERIODIC Or TIME_CALLBACK_FUNCTION)
Command1.Caption = "Stop"
Else
'Stop both timers
timeKillEvent hMMTimer
Timer1.Enabled = False
Command1.Caption = "Start"
'Show result
MsgBox "Timer1_Timer was called " & VBTimer & " times;" & vbNewLine & "TimerProc was called " & MMTimer & " times."
VBTimer = 0
MMTimer = 0
End If
End Sub
'In a module
Option Explicit
Public Const TIME_ONESHOT = 0 'Event occurs once, after uDelay milliseconds.
Public Const TIME_PERIODIC = 1 'Event occurs every uDelay milliseconds.
Public Const TIME_CALLBACK_EVENT_PULSE = &H20 'When the timer expires, Windows calls thePulseEvent function to pulse the event pointed to by the lpTimeProc parameter. The dwUser parameter is ignored.
Public Const TIME_CALLBACK_EVENT_SET = &H10 'When the timer expires, Windows calls theSetEvent function to set the event pointed to by the lpTimeProc parameter. The dwUser parameter is ignored.
Public Const TIME_CALLBACK_FUNCTION = &H0 'When the timer expires, Windows calls the function pointed to by the lpTimeProc parameter. This is the default.
Public Declare Function timeKillEvent Lib "winmm.dll" (ByVal uID As Long) As Long
Public Declare Function timeSetEvent Lib "winmm.dll" (ByVal uDelay As Long, ByVal uResolution As Long, ByVal lpFunction As Long, ByVal dwUser As Long, ByVal uFlags As Long) As Long
Public VBTimer As Long, MMTimer As Long
Public hMMTimer As Long
Sub TimerProc(ByVal uID As Long, ByVal uMsg As Long, ByVal dwUser As Long, ByVal dw1 As Long, ByVal dw2 As Long)
'Increment MMTimer
MMTimer = MMTimer + 1
End Sub