【Timer控件】问题
请教老师们，我的程序有N个过程用到延时，sleep(多线程中抢占优先权)之类的我暂时不考虑，我偏向使用Timer控件，如何才能在过程中启动Timer延时后又回到原来延时的语句后边，我的过程比较多用的延时，请老师们指点一个科学的方法，谢谢！
给个例子：
public sub a ()
语句……
Timer延时
语句……
语句……
Timer延时
语句……
end sub
public sub b ()
语句……
Timer延时
语句……
语句……
Timer延时
语句……
end sub
[解决办法]
延时一秒
dim t as single t=timer do doevents loop while timer-t <1
[解决办法]
Option ExplicitPrivate Sub Wait(ByVal MilliSeconds As Long) Timer1.Interval = MilliSeconds Timer1.Enabled = True While Timer1.Enabled DoEvents WendEnd SubPublic Sub a() Debug.Print Now, "Start Timer 1" Wait 2000 Debug.Print Now, "Finish Timer 1" Debug.Print Now, "Start Timer 2" Wait 4000 Debug.Print Now, "Finish Timer 2"End SubPrivate Sub Command1_Click() aEnd SubPrivate Sub Form_Load() Timer1.Enabled = FalseEnd SubPrivate Sub Timer1_Timer() Timer1.Enabled = FalseEnd Sub
[解决办法]
抢占优先权没什么关系吧，即便是用timer控件，也是执行完一个过程再执行下面的。
都是紧凑的步骤，省不下多少资源啊
[解决办法]
用Doevents时实际上就意味着要处理并行问题了,不过这也是没有办法的事了
[解决办法]
楼主看看这个，功能类似Sleep，但不独占CPU，不会阻塞别的任务
'lngD要延迟的时间，单位：ms
'Gettickcount：API函数，需要你自己添加声明
public sub subSleep(byval lngD as long)
dim lngP as long
lngP=Gettickcount
do
Doevents
loop until getTickcount-lngP>lngD
end sub
[解决办法]
使用以下类来实现等待，且不占CPU
[vbCode]
'***************************************
'类名：classWait
'用途：提供停等方法，且不占用CPU
'
'作者：Showen
'注意：该类在窗口未初始化完成之前不要使用
' 否则可能永远不返回
'版权：无版权，任意使用及修改，但修改之后记得发一份给我
'邮箱：langxw@qq.com
'***************************************
Option Explicit
Private Declare Function GetMessage Lib "user32" Alias "GetMessageA" (lpMsg As Msg, ByVal hwnd As Long, ByVal wMsgFilterMin As Long, ByVal wMsgFilterMax As Long) As Long
Private Declare Function PeekMessage Lib "user32" Alias "PeekMessageA" (lpMsg As Msg, ByVal hwnd As Long, ByVal wMsgFilterMin As Long, ByVal wMsgFilterMax As Long, ByVal wRemoveMsg As Long) As Long
Private Declare Function TranslateMessage Lib "user32" (lpMsg As Msg) As Long
Private Declare Function DispatchMessage Lib "user32" Alias "DispatchMessageA" (lpMsg As Msg) As Long
Private Const WM_CLOSE = &H10
Private Const WM_QUIT = &H12
Private Const WM_DESTROY = &H2
Private Type Msg
hwnd As Long
message As Long
wParam As Long
lParam As Long
time As Long
pt As POINTAPI
End Type
Private Declare Function QueryPerformanceCounter Lib "kernel32" (lpPerformanceCount As Currency) As Long
Private Declare Function QueryPerformanceFrequency Lib "kernel32" (lpFrequency As Currency) As Long
'等待一个条件，直到该条件为真,如果条件不为真，哪怕程序退出也不会返回
Public Sub WaitC(Byval lCAddres As long)
'Public Sub WaitC(ByVal lpC As Long)
Dim mm As Msg
Do Until GetBoolVal(lCAddres)
GetMessage mm, 0, 0, 0
TranslateMessage mm
DispatchMessage mm
Loop
End Sub
Private Function GetBoolValByAddress(ByVal lpB As Long) As Boolean
Dim bV As Boolean
CopyMemoryEx VarPtr(bV), lpB, 2
GetBoolValByAddress = bV
End Function
'millisecond为延时的毫秒数
Public Sub DelayTime(ByVal millisecond As Long)
Dim Ctr1, Ctr2, Freq As Currency
Dim Count As Double
Dim mm As Msg
If QueryPerformanceFrequency(Freq) Then
QueryPerformanceCounter Ctr1
Do
PeekMessage mm, 0, 0, 0, 1
'GetMessage mm, 0, 0, 0
TranslateMessage mm
DispatchMessage mm
QueryPerformanceCounter Ctr2
Loop While (Ctr2 - Ctr1) / Freq * 1000 < millisecond
Else
'不支持精确定时器
End If
End Sub
'millisecond为延时的毫秒数,窗口初始化完成之前慎用
Public Sub DelayTime2(ByVal millisecond As Long)
Dim Ctr1, Ctr2, Freq As Currency
Dim Count As Double
Dim mm As Msg
If QueryPerformanceFrequency(Freq) Then
QueryPerformanceCounter Ctr1
Do
'PeekMessage mm, 0, 0, 0, 1
GetMessage mm, 0, 0, 0
TranslateMessage mm
DispatchMessage mm
QueryPerformanceCounter Ctr2
Loop While (Ctr2 - Ctr1) / Freq * 1000 < millisecond
Else
'不支持精确定时器
End If
End Sub
[/vbCode]
[解决办法]
不能。
一个进程的代码只会单线执行，不可能 Command1_Click() 和 Command2_Click() 异步同时执行。
[解决办法]
Command1 用来控件数组以简化代码
Option ExplicitPrivate Type TypeTask ID As Long IsWating As Boolean OnTimer As SingleEnd TypePrivate Const TASK_COUNT As Long = 2Private m_Tasks(TASK_COUNT - 1) As TypeTaskPrivate Function TimerToString(ByVal f As Single) As String Dim lSeconds As Long Dim dt As Date lSeconds = Fix(f) dt = TimeSerial(0, lSeconds \ 60, lSeconds Mod 60) TimerToString = Format$(dt, "hh:mm:ss") & _ Format$(f - lSeconds, ".00")End FunctionPrivate Sub Command1_Click(Index As Integer) Dim fNow As Single fNow = Timer() With m_Tasks(Index) Debug.Print TimerToString(fNow), "Start Timer " & .ID .OnTimer = fNow + (Index + 1) .IsWating = True End WithEnd SubPrivate Sub Form_Load() Dim i As Long For i = 0 To TASK_COUNT - 1 m_Tasks(i).ID = i + 1 Next Timer1.Interval = 50 Timer1.Enabled = TrueEnd SubPrivate Sub Timer1_Timer() Dim fNow As Single Dim i As Long fNow = Timer() For i = 0 To TASK_COUNT - 1 With m_Tasks(i) If .IsWating Then If fNow >= .OnTimer Then Debug.Print TimerToString(fNow), "Finish Timer " & .ID .IsWating = False End If End If End With NextEnd Sub
[解决办法]
你试试10楼的类，基本上可以达到你的要求，别的地方该用timer的地方还用timer，都正常使用。
[解决办法]
同一个sub可以用你的代码的
public sub a()
语句……
Form1.Timer1.Interval = 1000: Form1.Timer1.Enabled = True
While Form1.Timer1
DoEvents
Wend
语句……
Form1.Timer2.Interval = 2000: Form1.Timer2.Enabled = True
While Form1.Timer2
DoEvents
Wend
语句……
end sub
