当前位置:编程学习 > VB >>

谁有好点的vb延时代码啊

谁有好点的vb延时代码啊 --------------------编程问答-------------------- 用Sleep不就好了
Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long) --------------------编程问答-------------------- --------------------编程问答-------------------- up --------------------编程问答-------------------- 自己用计时器函数写一个。 --------------------编程问答-------------------- 同意1楼
Sleep(1000)
延时一秒 --------------------编程问答-------------------- 不知道楼主是不是开发串口的程序,我也遇到过类似的问题发送数据循环读卡器的数量到接收的时候老是错过一个后来改mscomm控件的RThreshold值解决了 --------------------编程问答-------------------- '****************************************************************************
'人人为我,我为人人
'枕善居收藏整理
'发布日期:05/06/24
'描  述:定(延)时函数大比拼
'网  站:http://www.mndsoft.com/
'e-mail:mnd@mndsoft.com
'OICQ  : 88382850
Option Explicit
'**************************************
太长了,你到枕善居自己去找吧! --------------------编程问答--------------------
引用 7 楼 SYSSZ 的回复:
'**************************************************************************** 
'人人为我,我为人人 
'枕善居收藏整理 
'发布日期:05/06/24 
'描  述:定(延)时函数大比拼 
'网  站:http://www.mndsoft.com/ 
'e-mail:mnd@mndsoft.com 
'OICQ  : 88382850 
Option Explicit 
'************************************** 
太长了,你到枕善居自己去找吧!


给个具体连接嘛,那样好找
不过,我先去看看 --------------------编程问答-------------------- 你找不到的话贴个邮箱我发给你 --------------------编程问答-------------------- 这个延时函数就不错

Sub delay(ByVal n As Single) '延时过程
Dim tm1 As Long, tm2 As Long
tm1 = timeGetTime
Do
tm2 = timeGetTime
If (tm2 - tm1) / 1000 > n Then Exit Do
DoEvents
Loop
End Sub

要声明timeGetTime API的 --------------------编程问答-------------------- Public Declare Function GetTickCount Lib "kernel32" () As Long 
Public Sub delay(dTime As Double)‘已秒为单位,延时10秒只需要将dTime设置为10即可 
  Dim dStart As Double 
  dStart = GetTickCount \ 1000 
  Do While dStart > GetTickCount \ 1000 - dTime 
    DoEvents 
  Loop 
End Sub 
调用该过程就能达到延时作用。 --------------------编程问答-------------------- Sleep不管用!!!!!!!! --------------------编程问答-------------------- Private Function Wait(ByVal millSec As Double) As Long
    Dim startTime As Double
    startTime = Timer
    millSec = millSec / 1000

    While Timer - startTime < millSec

        DoEvents

    Wend

End Function --------------------编程问答-------------------- Option Explicit
Private Declare Function GetTickCount Lib "kernel32" () As Long
'GetTickCount比timeGetTime函数快

Private Sub Form_Load()
        Call Sleep(1)                                                                   '延时1秒
End Sub

Private Sub Sleep(ByVal dwTime As Long)
        Dim t As Long
        t = GetTickCount
        Do
          If (GetTickCount - t) \ 1000 >= dwTime Then
             Exit Do
          End If
          DoEvents
        Loop
End Sub --------------------编程问答--------------------

Option Explicit
Private Declare Function GetTickCount Lib "kernel32" () As Long
'GetTickCount比timeGetTime函数快

Private Sub Form_Load()
        Call Sleep(1)                                                                   '延时1秒
End Sub

Private Sub Sleep(ByVal dwTime As Long)
        Dim t As Long
        t = GetTickCount
        Do
          If (GetTickCount - t) \ 1000 >= dwTime Then
             Exit Do
          End If
          DoEvents
        Loop
End Sub
--------------------编程问答-------------------- 我有一个用time控件延时1个小时。。到无穷大时间
超级简单!!保证好用
Private Sub Form_Load()
Dim intMinute As integer
integer = 60
Timer1.Interval =1000
End Sub

Private Sub Timer1_Timer()
intMinute = intMinute - 1
If Val(intMinute) = 0 Then
'你要执行的程序
End If

End Sub --------------------编程问答-------------------- 更改一下
Private Sub Form_Load()
Dim intMinute As integer
integer = 60'设置延时时间,时间单位为分钟
Timer1.Interval =10000
End Sub

Private Sub Timer1_Timer()
intMinute = intMinute - 1
If intMinute = 0 Then
'你要执行的程序
End If
End Sub



--------------------编程问答-------------------- 延时还要那么复杂吗? --------------------编程问答-------------------- 参照资源:
http://download.csdn.net/source/752060 --------------------编程问答-------------------- 用 Timer 并设一个变量 
每一单位时间变量 +1
然后判断 把你想要的时间到了的时候变量的数就执行代码 --------------------编程问答-------------------- 弄了一个理论上达到毫秒级的计时器.....

拿这个去用用?嘿嘿. --------------------编程问答-------------------- Private Declare Function GetTickCount Lib "kernel32" () As Long
'%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
'函数功能:延迟指定时间(ms)
'参数说明:lngD:要延迟的时间,单位ms,必须大于等于0
'返回说明:正确执行,返回:1 失败,返回:0
'%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
public function funDelay(byval lngD as long ) as long
    dim lngP as long
on error goto errFun
    funDelay=0
    lngP=GetTickcount  
    Do
        DoEvents
    Loop until GetTickcount-lngP>=lngD
    funDelay=1
    exit function
errFun:
    funDelay=0
end funciton --------------------编程问答-------------------- 定时器
多媒体定时器(API)
sleep(API) --------------------编程问答--------------------

Private Type LARGE_INTEGER
    lowpart As Long
    highpart As Long
End Type

Private Declare Function QueryPerformanceCounter Lib "kernel32" (lpPerformanceCount As LARGE_INTEGER) As Long
Private Declare Function QueryPerformanceFrequency Lib "kernel32" (lpFrequency As LARGE_INTEGER) As Long

Private SYSHZ As Double

Public Function GetSYSHZ() As Double
    Dim tt As LARGE_INTEGER
    Dim res As Double
    
    QueryPerformanceFrequency tt
    If tt.lowpart < 0 Then
        res = 2 ^ 32 + tt.lowpart
    Else
        res = tt.lowpart
    End If
    res = res + 2 ^ 32 * tt.highpart
    GetSYSHZ = res
End Function

Private Function GetNowCounter() As Double
    Dim tt As LARGE_INTEGER
    Dim res As Double
    
    QueryPerformanceCounter tt
    If tt.lowpart < 0 Then
        res = 2 ^ 32 + tt.lowpart
    Else
        res = tt.lowpart
    End If
    res = res + 2 ^ 32 * tt.highpart
    GetNowCounter = res
End Function

Public Sub Delay(second As Double)
    Dim st As Double
    
    st = GetNowCounter
    Do
        DoEvents
    Loop Until (GetNowCounter - st) > second * SYSHZ
End Sub

Public Sub Main()
    SYSHZ = GetSYSHZ
    Delay 0.5
End
--------------------编程问答-------------------- 'function: 延时
'virant: iDelay=延时长度
'return:   null
'************************************************************************
Public Sub DelayTime(ByVal iDelay As Single)
    Dim sStart As Single
    sStart = Timer   ' 设置开始暂停的时刻。
    Do While Timer < sStart + iDelay
        If sStart - Timer > 80000 Then
            sStart = Timer
        End If
        If bIdle Then
            DoEvents   ' 将控制让给其他程序。
        Else
            Exit Sub
        End If
    Loop
End Sub
需要延迟多少直接传进来 --------------------编程问答--------------------  Public Declare Function GetTickCount Lib "kernel32" () As Short


    Public Sub DelayTime(ByVal DelayMsTime As Short) '定量延时程序
        Dim TimeDelay As Short
        TimeDelay = GetTickCount
        Do
            System.Windows.Forms.Application.DoEvents()
        Loop Until GetTickCount - TimeDelay > DelayMsTime

    End Sub
直接DelayTime  **** --------------------编程问答-------------------- 蹉跎岁月的帖子…… --------------------编程问答-------------------- --------------------编程问答-------------------- 自己写一个,或都用sleep --------------------编程问答-------------------- 蹉跎岁月的帖子 --------------------编程问答-------------------- .........路个过.... --------------------编程问答--------------------
引用 10 楼 syssz 的回复:
这个延时函数就不错

VB code

Sub delay(ByVal n As Single) '延时过程
Dim tm1 As Long, tm2 As Long
tm1 = timeGetTime
Do
tm2 = timeGetTime
If (tm2 - tm1) / 1000 > n Then Exit Do
DoEvents
Loop
End Sub

要……




延时有好几种方法, Sleep的API与 timeGetTime的API 与GetTickCount的API 以及Timer控件  Timer函数  循环(不需太精确时使用).....

我个人用在屏幕特效或语音播放,或流程监控.....我使用的是 GetTickCount API

在需要调用时只要 Call DelayCycle(?) 即可 '  ? = 填入你要延时的数值


'通用区
Private Declare Function GetTickCount Lib "kernel32" () As Long
Dim StartTm&

'***********************
Public Sub DelayCycle(Optional Dtm As Long)
   StartTm = GetTickCount
   Do
      DoEvents
   Loop Until GetTickCount >= StartTm + Dtm
End Sub



--------------------编程问答-------------------- 你们回得起劲,楼主发完帖子就没再看过 --------------------编程问答--------------------
引用 33 楼 zzhgb 的回复:
你们回得起劲,楼主发完帖子就没再看过

你发了后就没人有兴趣再发了,你挺能打击人家积极性的!
楼主看没看不重要,其他菜鸟看到了才重要!
比如说我看了就收获良多,谢谢各位! --------------------编程问答-------------------- --------------------编程问答-------------------- 都是好方法,学习了,谢谢 --------------------编程问答-------------------- 话说,我最近也在研究串口通讯的问题。经过一周的实验,发现光用一个sleep在for循环里,的确没用。即使自己编一个延时函数也是一样的。

而最后,我是通过DoEvents和sleep配套使用来解决的。

在for循环里的发送数据的语句之后添加DoEvents,在控件的发送事件里写sleep语句。如果是MSComm串口的,就是OnComm事件中判断comEvSend状态,如果是winsock控件的,就用它的SendComplete事件。

代码如下:

'winsock通信
Private Sub wskPort_SendComplete()
    Sleep 1000
End Sub
Private Sub Command2_Click()
    For i = 0 To scrnum - 1
        If client.State = 7 Then
            client.SendData i                      '这里写要发送的数据             
            DoEvents
        End If
    End For
End Sub

'msComm通信
Private Sub Command1_Click()
    Dim i As Integer
    mscPort.InBufferCount = 0                  '每次发送前清空缓存区
    mscPort.OutBufferCount = 0
    If mscPort.PortOpen = True Then
        For i = 0 To 9
            mscPort.Output = i                 '这里写要发送的数据
            DoEvents
        Next
    End If
End Sub
Private Sub mscPort_OnComm()
    Dim inp As String
    Select Case mscPort.CommEvent
        Case comEvSend
            Sleep (1500)                   '发送延时
        Case comEvReceive
            mscPort.InputLen = 0           '接收数据
            inp = mscPort.Input
            MsgBox inp
    End Select
End Sub
补充:VB ,  控件
CopyRight © 2012 站长网 编程知识问答 www.zzzyk.com All Rights Reserved
部份技术文章来自网络,