有什么办法代替sleep

[qiangshou2301]

我程序里有段：

            Call DataSend(&H67, MSComm1)
            Call Sleep(t67 * 1000)
            Call DataSend(&H6A, MSComm1)
            Call Sleep(t6a * 1000)
            Call DataSend(&H6C, MSComm1)
            Call Sleep(t6c * 1000)
            Call DataSend(&H67, MSComm1)
            Call Sleep(t67 * 1000)

执行到这里面来了，想退出这里面就不行，一直要等这4个sleep完了，才能退出，有什么其他的办法或者代替这个sleep？

[东方之珠]

http://topic.csdn.net/u/20091030/13/4703f521-a6d8-462f-b083-363bd2457954.html?seed=33925990&r=60796281#r_60796281

[fly1229]

延时函数,调用时 delay 1000

 Private   Declare   Function   timeGetTime   Lib   "winmm.dll"   ()   As   Long   
    
  Private   Sub   delay(dt as long)   
  Dim   Savetime   As   Double   
  ' "timeGetTime   begin"   
  Savetime   =   timeGetTime   '记下开始时的时间   
  While   timeGetTime   <   Savetime   +   dt   '循环等待   
  DoEvents   '转让控制权，以便让操作系统处理其它的事件。   
  Wend   
  ' "timeGetTime   end"   
  End   Sub   

[qiangshou2301]

加上DoEvents是能解决表面上的退出，只是程序不存在休眠状态，但是还是会继续执行后面的DataSend，数据还是在发送：
我整个程序是这样的：

'开始
Private Sub Timer5_Timer()
    Timer5.Enabled = False
    Dim currentdate As Date
    Dim currentdate1 As Date
    currentdate = Now
    currentdate1 = currentdate
    Do
        Do
            If Not isStarted Then
                Exit Do
            Else
                Call DataSend(&H66, MSComm1)
                DoEvents
                Call Sleep(t66 * 1000)
                Call DataSend(&H7E, MSComm1)
                DoEvents
                Call Sleep(t7e * 1000)
            End If
            DoEvents
        Loop While Not DateDiff("s", currentdate, Now) > lLoopTime * 60
        
        If Not isStarted Then
            Exit Do
        Else
            Call DataSend(&H67, MSComm1)
            DoEvents
            Call Sleep(t67 * 1000)
            Call DataSend(&H6A, MSComm1)
            DoEvents
            Call Sleep(t6a * 1000)
            Call DataSend(&H6C, MSComm1)
            DoEvents
            Call Sleep(t6c * 1000)
            Call DataSend(&H67, MSComm1)
            DoEvents
            Call Sleep(t67 * 1000)
            
            currentdate = Now
        End If
        
        DoEvents
    Loop While Not DateDiff("s", currentdate1, Now) > mLoopTime * 60
    
    isStarted = False
    Call EndSend  '执行结束程序
End Sub

想在程序中任何一个Call Sleep位置都能退出，执行Call EndSend。而不是去把后面的DataSend都执行完了才Call EndSend

[帝企鹅已被占用]

加个bln，
sleep换成doevent。
程序里要退出，bln = true
if not bln then goto subend。
在 Call EndSend上面加
subend：

[嗷嗷叫的老马]

要有一个模块级的变量,来让延时过程知道是否应该退出.

dim bExtiDelay as boolean

private sub Delay(byval lTime as long)
    dim I as long

    i=gettickcount
    do
        sleep 1
        doevents
        if (bExtiDelay) or (i+ltime<gettickcount) then exit do
    loop
    bExtiDelay=false
end sub

然后用Delay替换你代码里的sleep调用即可.

在需要紧急中断时将bExtiDelay设置为True即可.

[cbm6666]

Option Explicit
Private Declare Function GetTickCount Lib "kernel32" () As Long
Dim StartTm&

Private Sub Command1_Click()
Call DataSend(&H67, MSComm1)
Call DelayCycle(1000)
Call DataSend(&H6A, MSComm1)
Call DelayCycle(1000)
End Sub

Public Sub DelayCycle(Optional Dtm As Long)
On Error Resume Next
StartTm = GetTickCount
Do
DoEvents
Loop Until GetTickCount >= StartTm + Dtm
End Sub

[贝隆]

Option Explicit
Public Declare Function GetTickCount Lib "kernel32" () As Long
'％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％
'过程功能：延迟指定时间，单位毫秒
'参数说明：lngDelay：要延迟的毫秒数
'％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％
Public Sub subDelay(ByVal lngDelay As Long)
    Dim lngS As Long
On Error GoTo errSub
    If lngDelay <= 0 Then Exit Sub
    lngS = GetTickCount
    Do
        DoEvents
    Loop Until GetTickCount - lngS >= lngDelay
    Exit Sub
errSub:

End Sub

[嗷嗷叫的老马]

把我之前那个代码改改不就行了嘛.

既然要有退出后面发送过程的要求,那么肯定也需要判断一个用于退出的变量.

dim bExtiDelay as boolean

private function Delay(byval lTime as long) as boolean
    dim I as long

    i=gettickcount
    do
        sleep 1
        doevents
        if (bExtiDelay) or (i+ltime<gettickcount) then 
            Delay=bExtiDelay
            exit do
        end if
    loop   
end function

在每次Call DataSend()之前,判断一下上面函数的返回值就行了嘛.

Call DataSend(&H66, MSComm1)      '第一句SEND,不作判断
if not Delay(3000) then Call DataSend(&H7E, MSComm1)   '第二句开始,就判断返回值.

dim bExtiDelay as boolean放在公共声明区,用一个紧急取消按钮来设置值为TRUE,并在下次开始发送前置FALSE.

这样应该够清楚了吧...

不过话说回来,这种硬延时我觉得利用COMM控件的事件来进行流程控制更好.

[qiangshou2301]

老马兄啊 ，还是不清楚你的意思，是这样吗？不行啊！
Private Sub Timer5_Timer()
Timer5.Enabled = False
Dim currentdate As Date
Dim currentdate1 As Date
currentdate = Now
currentdate1 = currentdate
Do
Do
If Not isStarted Then
Exit Do
Else
Call DataSend(&H66, MSComm1)
If Delay(t66 * 1000) Then Call DataSend(&H7E, MSComm1) '第二句开始,就判断返回值.
bExtiDelay = True
Call Delay(t7e * 1000)
End If

Loop While Not DateDiff("s", currentdate, Now) > lLoopTime * 60

If Not isStarted Then
Exit Do
Else
Call DataSend(&H67, MSComm1)
'Call Delay(t67 * 1000)
If Delay(t67 * 1000) Then Call DataSend(&H6A, MSComm1)
bExtiDelay = True
'Call Delay(t6a * 1000)
If Delay(t6a * 1000) Then Call DataSend(&H6C, MSComm1)
bExtiDelay = False
'Call Delay(t6c * 1000)
If Delay(t6c * 1000) Then Call DataSend(&H67, MSComm1)
bExtiDelay = True
Call Delay(t67 * 1000)
currentdate = Now
End If
Loop While Not DateDiff("s", currentdate1, Now) > mLoopTime * 60
isStarted = False
Call EndSend '执行结束程序，发送结束协议
End Sub

[qiangshou2301]

老马兄啊 ，还是不清楚你的意思，是这样吗？不行啊！

Private Sub Timer5_Timer() 
    Timer5.Enabled = False 
    Dim currentdate As Date 
    Dim currentdate1 As Date 
    currentdate = Now 
    currentdate1 = currentdate 
    Do 
        Do 
            If Not isStarted Then 
                Exit Do 
            Else 
                Call DataSend(&H66, MSComm1) 
                If Delay(t66 * 1000) Then Call DataSend(&H7E, MSComm1)  '第二句开始,就判断返回值. 
                bExtiDelay = True 
                Call Delay(t7e * 1000) 
                End If 
            
        Loop While Not DateDiff("s", currentdate, Now) > lLoopTime * 60 
        
        If Not isStarted Then 
            Exit Do 
        Else 
            Call DataSend(&H67, MSComm1) 
            'Call Delay(t67 * 1000) 
            If Delay(t67 * 1000) Then Call DataSend(&H6A, MSComm1) 
            bExtiDelay = True 
            'Call Delay(t6a * 1000) 
            If Delay(t6a * 1000) Then Call DataSend(&H6C, MSComm1) 
            bExtiDelay = False 
            'Call Delay(t6c * 1000) 
            If Delay(t6c * 1000) Then Call DataSend(&H67, MSComm1) 
            bExtiDelay = True 
            Call Delay(t67 * 1000) 
            currentdate = Now 
        End If 
    Loop While Not DateDiff("s", currentdate1, Now) > mLoopTime * 60 
    isStarted = False 
    Call EndSend  '执行结束程序，发送结束协议 
End Sub

其他的我也试了，还是会发送完后面的，才彻底结束发送。

[「已注销」]

http://topic.csdn.net/u/20091016/17/e3c0adf9-1373-45dc-8a73-1faa41b5ea70.html

[liguicd]

看热闹

[qiangshou2301]

cbm666，还是只能解决表面上的退出，只是程序不存在休眠状态，但是还是会继续执行后面的DataSend，数据还是在发送。
老马与fly1229的针对下面的程序不知道如何做起，小弟是新手，请指教。

'执行command控件开始执行Timer5
Private Sub Timer5_Timer()
    Timer5.Enabled = False
    Dim currentdate As Date
    Dim currentdate1 As Date
    currentdate = Now
    currentdate1 = currentdate
    Do
        Do
            If Not isStarted Then
                Exit Do
            Else
                Call DataSend(&H66, MSComm1)
                DoEvents
                Call Sleep(t66 * 1000)
                Call DataSend(&H7E, MSComm1)
                DoEvents
                Call Sleep(t7e * 1000)
            End If
            DoEvents
        Loop While Not DateDiff("s", currentdate, Now) > lLoopTime * 60
        
        If Not isStarted Then
            Exit Do
        Else
            Call DataSend(&H67, MSComm1)
            DoEvents
            Call Sleep(t67 * 1000)
            Call DataSend(&H6A, MSComm1)
            DoEvents
            Call Sleep(t6a * 1000)
            Call DataSend(&H6C, MSComm1)
            DoEvents
            Call Sleep(t6c * 1000)
            Call DataSend(&H67, MSComm1)
            DoEvents
            Call Sleep(t67 * 1000)
            
            currentdate = Now
        End If
        
        DoEvents
    Loop While Not DateDiff("s", currentdate1, Now) > mLoopTime * 60
    
    isStarted = False
    Call EndSend  '执行结束程序，发送结束协议
End Sub
Public Sub EndSend()
    Call DataSend(&H7E, MSComm1)'结束协议，直接结束

End Sub

我的目的：想在程序中任何一个Call Sleep位置点击一个command控件都能退出发送这些协议，执行Call EndSend里的东西。而不是去把后面的协议发送完了（即DataSend都执行完了）才Call EndSend

请高手结合我的程序帮看下，谢谢了！

[luofenghen]

用TIMER 计时器延时吧 从TIMER1.ENABLE =TRUE 开始计时

'执行command控件开始执行Timer5
Private Sub Timer5_Timer()
    Timer5.Enabled = False
    Dim currentdate As Date
    Dim currentdate1 As Date
    currentdate = Now
    currentdate1 = currentdate
    Do
        Do
            If Not isStarted Then
                Exit Do
            Else
                Call DataSend(&H66, MSComm1)
                DoEvents
                Call Sleep(t66 * 1000)
                Call DataSend(&H7E, MSComm1)
                DoEvents
                Call Sleep(t7e * 1000)
            End If
            DoEvents
        Loop While Not DateDiff("s", currentdate, Now) > lLoopTime * 60
        
        If Not isStarted Then
            Exit Do
        Else
            Call DataSend(&H67, MSComm1)
'默认设置timer6，tiemr7,tiemr8都是false
timer6.enable=true
            Call DataSend(&H6A, MSComm1)
tiemr7.enable=true
            Call DataSend(&H6C, MSComm1)
tiemr8.enable=true
            Call DataSend(&H67, MSComm1)
tiemr9.enable=true  
            currentdate = Now
        End If
        
        DoEvents
    Loop While Not DateDiff("s", currentdate1, Now) > mLoopTime * 60
    
    isStarted = False
    Call EndSend  '执行结束程序，发送结束协议
End Sub
Public Sub EndSend()
    Call DataSend(&H7E, MSComm1)'结束协议，直接结束

End Sub
'在from_load里写好timer6和其他的timer的频率，timer6.inteval=10000 ‘10秒
'以下手写代码 不规范
private sub timer6_timer 
timer6.enable=false
end sub

觉得合理就试试

[帝企鹅已被占用]

正因为你有多次loop。看看我5楼的建议。

[luofenghen]

以上代码不合理~~~~~~~~~

[贝隆]

Option Explicit

'执行command控件开始执行Timer5
Private Sub Timer5_Timer()
    Timer5.Enabled = False
    Dim currentdate As Date
    Dim currentdate1 As Date
    currentdate = Now
    currentdate1 = currentdate
    Do
        Do
            If Not isStarted Then
                Exit Do
            Else
                Call DataSend(&H66, MSComm1)
                Call subDelay(t66 * 1000)
                Call DataSend(&H7E, MSComm1)
                Call subDelay(t7e * 1000)
            End If
        Loop While Not DateDiff("s", currentdate, Now) > lLoopTime * 60
        
        If Not isStarted Then
            Exit Do
        Else
            Call DataSend(&H67, MSComm1)
            Call subDelay(t67 * 1000)
            Call DataSend(&H6A, MSComm1)
            Call subDelay(t6a * 1000)
            Call DataSend(&H6C, MSComm1)
            Call subDelay(t6c * 1000)
            Call DataSend(&H67, MSComm1)
            Call subDelay(t67 * 1000)
            currentdate = Now
        End If
    Loop While Not DateDiff("s", currentdate1, Now) > mLoopTime * 60
    isStarted = False
    Call EndSend  '执行结束程序，发送结束协议
End Sub
Public Sub EndSend()
    Call DataSend(&H7E, MSComm1) '结束协议，直接结束
End Sub

subDelay过程，参见我在10楼的代码，把它添加到一个标准模块中

[baiyiqny]

对于这样的问题
我做一下自己的看法，可以这样
做一个函数只用于发送数据
Call DataSend(&H67, MSComm1)//这里有了就不用写了
看上面的发送数据不同的不多
申请一个存放要发送数据的数组和一个刻录发送的位置（用于以后更新数组什么的）
然后就是时间数组和“指针”（只是这里可以当成指针）
如果对时间精确度要求不太高，时间也可以用integer类型表示，timer控件就可以
一个timer控件，我用着好像不太准，用两个，同时调用两个时间，如果提前发送数据，把上面的指针什么的同时+1，并再调整下一组时间，应该能做到！
这里只说了自己的看法！这样对CPU的占用很小！

[guyehanxinlei]

UP

[qiangshou2301]

谢谢老马