VB的延时函数！CPU100％

制造末日

我用的延时函数  

Public Sub Delay(mSec As Long)
      On Error GoTo ShowErr
         
      Dim TStart     As Single
         
      TStart = Timer
         
      While (Timer - TStart) < (mSec / 1000)  
            DoEvents
      Wend
      Exit Sub
ShowErr:
      MsgBox Err.Source & "------" & Err.Description  
      Exit Sub
   
End Sub



但cpu一直在％  
请问哪位大大能提供节省资源的延时函数

ejx2005

直接调用API函数SLEEP不就完了&nbsp;
用法直接 sleep(毫秒数)&nbsp;
当然需要声明的

飙黑狂马

Sleep函数会导致进程被挂起,如果你是注入的话就不要用...

netant

Sleep如果在主线程中使用会使主线程的消息列队被阻塞也就是你所说的"挂起"
但是你那个一延迟函数始终占用着ＣＰＵ时间，其它线程得不到可用的ＣＰＵ时间  
片，这是造成你程序占用资源很高的原因，   
按照你现在的程序，很难再减少你程序占用的资源的．
如果要解决这个问题你只能用多线程的方式来操作．在创建的线程中使用Sleep 来达到你想要的延迟效果，记住在创建的线程中就不要用你那个延迟函数了

oowoo

如果不想用线程我提供给你两个方法  

1,WaitForSingleObject函数，来写模拟一个延迟函数吧，那样会好一些  
2,使用消息机制来实现"延迟"，也就是不用延迟，这个也是最好的方法，  
但也是最有难度的，是现在内存挂通常使用的方法．  
使用CreateRemoteThread在目标进程中创建远程线程，在线程函数中  
取值比较然后用SendMessage给你的程序发送消息，你的程序再根据发  
来的消息做出相应的操作．  

最后说一下你的函数  
Public Sub Delay(mSec As Long)
    On Error GoTo ShowErr
     
    Dim TStart   As Single
     
    TStart = Timer
     
    While (Timer - TStart) < (mSec / 1000)  
        DoEvents
    Wend
    Exit Sub

我不清楚ＶＢ中这个Timer是如何实现的（或是你自己现实的）  
你最好是用GetTickCount来做这个工作，如果Timer也是这样做的你就当我没说．  
Public Sub Delay(mSec As Long)
    On Error GoTo ShowErr
     
  TStart = GetTickCount
     
    While (GetTickCount - TStart) < (mSec / 1000)  
        DoEvents
    Wend
    Exit Sub

bados

呵呵，  楼主的问题恐怕是所有VB用户不爽的一个问题。
oowoo讲得很清楚了。新建一个线程把所有费事的操作丢线程里去就没事了

人谈路

我给你提借供一个,你看行不~~  
CPU占有不高,我很多程序都在用,  
Private Sub Wait(x10ms) '时间函数  
  Dim t As Long
  t = Timer * 100 + x10ms
  Do
    DoEvents
  Loop While Timer * 100 < t
End Sub


个人认为,还是用oowoo说的,弄个假线程好点

19880801

不停地循环肯定占CPU，用Sleep确实会造成程序无响应，下面的是我现在的延时函数，基本上我的CPU使用率一直为  
Public Function DelayTime(ByVal num As Long)   'num为延时数量，不一定是毫秒数，这个要自己去测试，所以这个延时不是很准确  
Dim sTime As Long
sTime = 1
While sTime <= num
  sTime = sTime + 1
  DoEvents
  Sleep 1
Wend
End Function

esay

放个定时器不行吗？
我只会ｖｃ，但ｖｂ中应该也有定时器的

雨锋林

这样做应该不占用很高了  

Public Sub Delay(mSec As Long)
    On Error GoTo ShowErr
     
    Dim TStart   As Single
     
    TStart = Timer
     
    While (Timer - TStart) < (mSec / 1000)  
        sleep(10)
        DoEvents
    Wend
    Exit Sub
ShowErr:
    MsgBox Err.Source & "------" & Err.Description  
    Exit Sub

End Sub