3种延时方法,那种好一些?请大家研究一下。(附代码)
第一种方法:
'在一个窗体中
'一个按纽 command1
'////////////////
Dim delay As Integer
Private Sub Command1_Click()
Timer1.Enabled = True
wait (5)
MsgBox "over"
Timer1.Enabled = False
End Sub
Private Sub Timer1_Timer()
delay = delay + 1
End Sub
Private Function wait(ByVal aaa As Integer)
Do While delay < aaa
DoEvents
Loop
delay = 0
End Function
第二种方法
'在一个窗体中
'两个按纽 command1,command2
'////////////////
Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Private Declare Function SleepEx Lib "kernel32" (ByVal dwMilliseconds As Long, ByVal bAlertable As Long) As Long
'用: Sleep 2000
'或:Sleep 2000,false(不能被唤醒)
' Sleep 2000,True(可被唤醒)
Private Sub Command1_Click()
Sleep 5000
MsgBox "over"
End Sub
Private Sub Command2_Click()
SleepEx 5000, True
MsgBox "over"
End Sub
第三种方法:
'在一个窗体中
'一个按纽 command1
'////////////////
Option Explicit
Private Sub Command1_Click()
Wait (5)
MsgBox "over"
End Sub
'在一个标准模块中
'************************************************************************************
'定时控制
'************************************************************************************
Private Type FILETIME
dwLowDateTime As Long
dwHighDateTime As Long
End Type
Private Const WAIT_ABANDONED& = &H80&
Private Const WAIT_ABANDONED_0& = &H80&
Private Const WAIT_FAILED& = -1&
Private Const WAIT_IO_COMPLETION& = &HC0&
Private Const WAIT_OBJECT_0& = 0
Private Const WAIT_OBJECT_1& = 1
Private Const WAIT_TIMEOUT& = &H102&
Private Const INFINITE = &HFFFF
Private Const ERROR_ALREADY_EXISTS = 183&
Private Const QS_HOTKEY& = &H80
Private Const QS_KEY& = &H1
Private Const QS_MOUSEBUTTON& = &H4
Private Const QS_MOUSEMOVE& = &H2
Private Const QS_PAINT& = &H20
Private Const QS_POSTMESSAGE& = &H8
Private Const QS_SENDMESSAGE& = &H40
Private Const QS_TIMER& = &H10
Private Const QS_MOUSE& = (QS_MOUSEMOVE _
Or QS_MOUSEBUTTON)
Private Const QS_INPUT& = (QS_MOUSE _
Or QS_KEY)
Private Const QS_ALLEVENTS& = (QS_INPUT _
Or QS_POSTMESSAGE _
Or QS_TIMER _
Or QS_PAINT _
Or QS_HOTKEY)
Private Const QS_ALLINPUT& = (QS_SENDMESSAGE _
Or QS_PAINT _
Or QS_TIMER _
Or QS_POSTMESSAGE _
Or QS_MOUSEBUTTON _
Or QS_MOUSEMOVE _
Or QS_HOTKEY _
Or QS_KEY)
Private Declare Function CreateWaitableTimer Lib "kernel32" _
Alias "CreateWaitableTimerA" ( _
ByVal lpSemaphoreAttributes As Long, _
ByVal bManualReset As Long, _
ByVal lpName As String) As Long
Private Declare Function OpenWaitableTimer Lib "kernel32" _
Alias "OpenWaitableTimerA" ( _
ByVal dwDesiredAccess As Long, _
ByVal bInheritHandle As Long, _
ByVal lpName As String) As Long
Private Declare Function SetWaitableTimer Lib "kernel32" ( _
ByVal hTimer As Long, _
lpDueTime As FILETIME, _
ByVal lPeriod As Long, _
ByVal pfnCompletionRoutine As Long, _
ByVal lpArgToCompletionRoutine As Long, _
ByVal fResume As Long) As Long
Public Declare Function CancelWaitableTimer Lib "kernel32" ( _
ByVal hTimer As Long)
Public Declare Function CloseHandle Lib "kernel32" ( _
ByVal hObject As Long) As Long
Private Declare Function WaitForSingleObject Lib "kernel32" ( _
ByVal hHandle As Long, _
ByVal dwMilliseconds As Long) As Long
Private Declare Function MsgWaitForMultipleObjects Lib "user32" ( _
ByVal nCount As Long, _
pHandles As Long, _
ByVal fWaitAll As Long, _
ByVal dwMilliseconds As Long, _
ByVal dwWakeMask As Long) As Long
Private Declare Function GetLastError Lib "kernel32" () As Long
'************************************************************************************
Public hTimer As Long '定时器句柄
Public Sub Wait(lNumberOfSeconds As Long)
Dim ft As FILETIME
Dim lBusy As Long
Dim lRet As Long
Dim dblDelay As Double
Dim dblDelayLow As Double
Dim dblUnits As Double
Dim ErrCode As Long
On Error GoTo HELL
hTimer = CreateWaitableTimer(0, True, App.EXEName & "Timer")
If Err.LastDllError = ERROR_ALREADY_EXISTS Then
ErrCode = GetLastError()
If ErrCode <> 0 Then
'WriteErrLog Nothing, "Modinitial.Wait", 418, "Sysrem Error, Code: " & ErrCode
Err.Clear
End If
' If the timer already exists, it does not hurt to open it
' as long as the person who is trying to open it has the
' proper access rights.
Else
ft.dwLowDateTime = -1
ft.dwHighDateTime = -1
lRet = SetWaitableTimer(hTimer, ft, 0, 0, 0, 0)
End If
' Convert the Units to nanoseconds.
dblUnits = CDbl(&H10000) * CDbl(&H10000)
dblDelay = CDbl(lNumberOfSeconds) * 1000 * 10000
' By setting the high/low time to a negative number, it tells
' the Wait (in SetWaitableTimer) to use an offset time as
' opposed to a hardcoded time. If it were positive, it would
' try to convert the value to GMT.
ft.dwHighDateTime = -CLng(dblDelay / dblUnits) - 1
dblDelayLow = -dblUnits * (dblDelay / dblUnits - _
Fix(dblDelay / dblUnits))
If dblDelayLow < CDbl(&H80000000) Then
' &H80000000 is MAX_LONG, so you are just making sure
' that you don't overflow when you try to stick it into
' the FILETIME structure.
dblDelayLow = dblUnits + dblDelayLow
End If
ft.dwLowDateTime = CLng(dblDelayLow)
lRet = SetWaitableTimer(hTimer, ft, 0, 0, 0, False)
Do
' QS_ALLINPUT means that MsgWaitForMultipleObjects will
' return every time the thread in which it is running gets
' a message. If you wanted to handle messages in here you could,
' but by calling Doevents you are letting DefWindowProc
' do its normal windows message handling---Like DDE, etc.
lBusy = MsgWaitForMultipleObjects(1, hTimer, False, _
INFINITE, QS_ALLINPUT&)
DoEvents
Loop Until lBusy = WAIT_OBJECT_0
' Close the handles when you are done with them.
CloseHandle hTimer
Exit Sub
HELL:
ErrCode = GetLastError()
'WriteErrLog Nothing, "Modinitial.Wait", 476, "Sysrem Error, Code: " & ErrCode
Err.Clear
Resume Next
End Sub
相关推荐
微软教材中文版SQL Srever2005 课后题答案
微软SQL Srever2005中文版教材,对应微软认证的70-431
易语言实现Winsock完成端口的项目源码下载
完成端口(IO Completion Ports,简称IOCP)是一种高效的I/O模型,尤其适用于大规模网络通信场景。它通过在内核级高效管理多个I/O操作来优化资源利用。IOCP允许程序以非阻塞方式处理大量并发I/O请求,适合实现高性能网络服务。I/O 完成端口(IO Completion Ports,简称 IOCP)是 Windows 系统中一种高性能的 I/O 模型,它基于异步 I/O 设计。
深入理解Windows完成端口:PiggyXP项目源码解析
I/O完成数据结构通常包含以下几个字段:// 完成键值// 实际传输的字节数// 指向OVERLAPPED结构的指针Key:与I/O请求关联的完成键值,这个值在请求提交时指定。:I/O操作实际传输的数据量。Overlapped:指向发起I/O请求时使用的OVERLAPPED结构体。
深入解析Windows I/O完成端口编程与实践
IOCP(I/O 完成端口)是 Windows 系统中用于实现高性能异步 I/O 操作的一种机制。其基本思想是通过线程池技术,充分利用系统资源,提高应用程序处理大量 I/O 请求的能力。IOCP 基于 I/O 完成函数模型(IO Completion Function Model),当异步 I/O 操作完成时,操作系统将相关的 I/O 完成数据包(IOCP)投递到指定的完成端口上。应用程序通过调用函数,从完成端口上获取 I/O 完成数据包,并执行相应的处理逻辑。
YOLO26算法工业车间与城市道路安全标识及交通标志目标检测+训练好的模型+260张数据集+pyqt可视化界面.zip
附训练好的 YOLO 权重与 PyQt 可视化检测界面,页面底部含可视化效果预览,毕设/课设开箱即用。 【数据集概况】 · 检测类别(中文):[安全标识(safety), 交通标志(traffic)] · 训练集:240 张 · 验证集:10 张 · 测试集:10 张 · 总计:260 张 该数据集精准聚焦于工业生产环境与城市道路交通场景,旨在为高危作业区域的安全警示系统及道路通行管理提供可靠视觉识别支持。通过采集真实工作现场与道路环境中的关键标识,该数据集有效支撑了对人员行为规范提示与交通状态预警的自动化感知需求,具备显著的工程实用价值与行业落地潜力。... 【训练曲线与评估图】 【模型训练配置】 参数 | 值 模型 | yolo26n 训练轮数 | 100 epochs 输入尺寸 | 640x640 批次大小 | 24 优化器 | auto 初始学习率 | 0.01 训练设备 【关键指标汇总】 训练了 67 个 epoch,最终轮指标: 指标 | 数值 mAP50 | **0.7278** mAP50-95 | 0.6630 Precision | 0.7294 Recall | 0.7273 train/box_loss | 0.7483 train/cls_loss | 0.6857 val/box_loss | 0.6823 val/cls_loss | 1.8035 【训练过程分析】 67 轮训练后 mAP50 为 0.7278,模型基本收敛但还有提升余地。Loss 曲线下降正常,后期趋于平缓。mAP50-95 为 0.6630,定位精度尚可。 【模型性能评估】 Precision 0.7294、Recall 0.7273,精度高于召回,存在一定漏检。多类检测中,不同类别性能可能有差异,需关注... 使用场景:毕业设计、课程设计、深度学习入门、工业场景落地验证。


VB基础类
