DoEvents应用

版权声明:本文为博主原创文章,未经博主允许不得转载。 https://blog.csdn.net/NCTU_to_prove_safety/article/details/54406829
转让控制权,以便让操作系统处理其它的事件。
  DoEvents 函数会返回一个 Integer,以代表 Visual Basic 独立版本中打开的窗体数目,例如,Visual Basic,专业版,在其它的应用程序中,DoEvents 返回 0。
  DoEvents 会将控制权传给操作系统。当操作系统处理完队列中的事件,并且在 SendKeys 队列中的所有键也都已送出之后,返回控制权。
  DoEvents 对于简化诸如允许用户取消一个已启动的过程 — 例如搜寻一个文件 — 特别有用。对于长时间过程,放弃控制权最好使用定时器或通过委派任务给 ActiveX EXE 部件来完成。以后,任务还是完全独立于应用程序,多任务及时间片由操作系统来处理。
  小心 确保以 DoEvents 放弃控制权的过程,在第一次 DoEvents 返回之前,不能再次被其他部分的代码调用;否则会产生不可预料的结果。此外,如果其它的应用程序可能会和本过程以不可预知的方式进行交互操作,那么也不要使用 DoEvents,因为此时不能放弃控制权。
  使用 DoEvents
  尽管 Timer 事件是后台处理的最好工具,对耗时极多的任务,情况更是如此,但是,DoEvents 函数还是提供了一种取消任务的简便方法。例如,下列代码将显示一个 "Process" 按钮,单击这个按钮时,它将变成 "Cancel" 按钮。再次单击按钮又将中断正在执行的任务。
  ´此按钮标题是 "Process"
  Private Sub Command1_Click()
  ´过程的所有实例都共享静态变量。
  Static blnProcessing As Boolean
  Dim lngCt As Long
  Dim intYieldCt As Integer
  Dim dblDummy As Double
  ´按下按钮时,检测是否在处理
  If blnProcessing Then
  ´如果正在处理,则取消
  blnProcessing = False
  Else
  Command1.Caption = "Cancel"
  blnProcessing = True
  lngCt = 0
  ´执行一百万次浮点乘法计算。每一千次后,检测是否要取消。
  Do While blnProcessing And (lngCt < 1000000)
  For intYieldCt = 1 To 1000
  lngCt = lngCt + 1
  dblDummy = lngCt * 3.14159
  Next intYieldCt
  ´DoEvents 语句允许其它事件发生,包括第二次按此按钮。
  DoEvents
  Loop
  blnProcessing = False
  Command1.Caption = "Process"
  MsgBox lngCt & " multiplications were performed"
  End If
  End Sub
展开阅读全文

Winsock与DoEvents相关问题

03-04

[code=vb]rn''数据处理rnPrivate Sub WskServer_DataArrival(Index As Integer, ByVal bytesTotal As Long)rnOn Error GoTo Errrn Dim tmpinfo() As Bytern rn WskServer(Index).GetData tmpinfo, vbArray + vbBytern ActiveSocks(Index).rCount = 1rnrn If (Not IsNull(tmpinfo)) Thenrn Call DataProc(tmpinfo)rn End Ifrn rn Exit SubrnErr:rn Call SaveParamFile("转发终端数据包出错!错误码为" & Err.Description)rnEnd Subrn''解数据rnPublic Sub DataProc(ByRef tmpinfo() As Byte)rnOn Error GoTo w_errrn rn If (tmpinfo(0) = (255 - tmpinfo(1))) Thenrn Select Case tmpinfo(0)rn Case &HE2 ''连接返回rn Call ConnectResp(tmpinfo)rn Case &H11 ''信号包信息转发rn Call GPS_XHZF(tmpinfo)rn Case &HE3 '' 实时连接返回rn ActiveSocks(0).rCount = 1rn Case Elsern rn End Selectrn End Ifrn rnExit Subrnw_err:rn Call SaveParamFile("转发终端数据包出错!错误码为" & Err.Description)rnEnd Subrn''GPS信号转发到客户端rnPublic Sub GPS_XHZF(ByRef tmpinfo() As Byte)rnOn Error GoTo Errrn Dim sql As Stringrn Dim k As Integerrn Dim i As Integer, j As Integer, iCnt As Integer, n As Integerrn Dim iLen As Integerrn Dim bAA(25) As Bytern Dim tmpAA() As Bytern Dim m As Integerrn rn iLen = UBound(tmpinfo) + 1rn If (iLen < 5) Then Exit Subrn If (iLen <= 26) Thenrn ''转发到客户端rn For i = 1 To Grid2.Rows - 1rn If Grid2.TextMatrix(i, 1) <> "" Thenrn Call SendInfo_K(tmpinfo, Val(Grid2.TextMatrix(i, 1)))rn End Ifrn Next irn ''显示转发信息rn Call ShowStatusMsg("接收转发: 11,Len=" & UBound(tmpinfo) + 1 & ",COM_ID=" & tmpinfo(3) & ",CAR_ID=" & tmpinfo(4) & ",IP=" & sServerIP)rn ''保存车辆连接信息rn sql = "UPDATE SbInfo_Table SET cIP='" & sServerIP & "',cGPSTime='" & Format(Now(), "yyyy-mm-dd HH:MM:SS") & "' WHERE iCarID=" & Val(tmpinfo(4)) & ""rn Call DB_A.Execute(sql, k)rn Elsern ''拆包分发rn iCnt = iLen / 26rn For i = 0 To iCnt - 1rn n = 26 * irn If n + 25 > UBound(tmpinfo) Then Exit Sub ''大于上限值退出rn For j = 0 To 25rn bAA(j) = tmpinfo(n + j)rn Next jrn tmpAA = bAArn ''转发到客户端rn For m = 1 To Grid2.Rows - 1rn If Grid2.TextMatrix(m, 1) <> "" Thenrn [color=#FF0000]Call SendInfo_K(tmpAA, Val(Grid2.TextMatrix(m, 1)))[/color]rn End Ifrn Next mrn ''显示转发信息rn Call ShowStatusMsg("接收转发: 11,Len=" & UBound(tmpAA) + 1 & ",COM_ID=" & tmpAA(3) & ",CAR_ID=" & tmpAA(4) & ",IP=" & sServerIP)rn ''保存车辆连接信息rn sql = "UPDATE SbInfo_Table SET cIP='" & sServerIP & "',cGPSTime='" & Format(Now(), "yyyy-mm-dd HH:MM:SS") & "' WHERE iCarID=" & Val(tmpAA(4)) & ""rn Call DB_A.Execute(sql, k)rn Next irn End Ifrn rn Exit SubrnErr:rn Call SaveParamFile("转发GPS数据包出错!错误码为" & Err.Description)rnEnd Subrn''转发信息-客户端rnPrivate Sub SendInfo_K(ByRef RecData() As Byte, ByVal Index As Integer)rnOn Error GoTo Errrn Dim Buffer() As Bytern rn Buffer = RecDatarn [color=#FF0000] WskServer_c(Index).SendData Bufferrn DoEvents[/color]rn rn Exit SubrnErr:rn Call SaveParamFile("SendInfo_K转发信息出错!错误码为" & Err.Description)rnEnd Sub[/code]rn================================================================================rn请教各位同仁,以上代码,在接收数据包量比较少时,运行正常稳定。rn但当接收数据包量比较大时,平均1秒3个数据包,运行一段时间后,异常自动退出。rn我个人理解是不是加DoEvents后,重入引起内存冲突?但不加DoEvents无法将每一数据包发出。rn如何解决重入问题? 论坛

vb.net DoEvents的奇怪问题!!!

12-21

今天 使用 vb.net DoEvents碰到一个很奇怪的问题,就是DoEvents后面的代码不执行。rnrn程序是在一个函数内,启动了一个timer做一些工作,然后主函数等待,检查某个变量,知道这个变量为某值,才结束等待,并返回相应的值。被主函数检查的变量, 在timer事件中处理程序中赋值。rnrn大概的例子可能是如下:故障现象是:主过程中 str1 = fun1()前面的语句能正常执行,后面的程序不会运行。调试监控后发现:程序 运行到 Application.DoEvents() 结束,不会再继续运行。rnrn而且这一现象不是没回都出现,而是有时发生,有时不发生。rnrn不知各位有没有碰到次问题。rnrn--------示例代码:-----------------------rnrn Sub main1()rn 。。。。。。rn Dim str1 As Stringrn str1 = fun1()rn 。。。。。。rn End Subrnrnrnrn Function fun1() As Stringrn t1 = New Timer()rn t1.Interval = 2000rn AddHandler t1.Tick, AddressOf t1_Tickrn Dim ii As Int16rn t1.Start()rn For ii = 0 To 2 Step 0rnrn If v_xx = 1 Thenrn Exit Forrn End Ifrn Application.DoEvents()rn Nextrn Return v_xx.ToStringrn End Functionrnrn Dim t1 As Timerrn Dim v_xx As UInt16 = 0rn Private Sub t1_Tick(ByVal sender As Object, ByVal e As System.EventArgs)rn Tryrn t1.Stop()rn If read_data() = True Thenrn v_xx = 1rn End Ifrn Catch ex As Exceptionrn Finallyrn If v_xx <> 1 Thenrn t1.Start()rn End Ifrn End Tryrn End Subrnrn Function read_data() As Boolean '读取数据,例如串口通讯程序rn '具体代码rn 。。。。。。rn End Functionrn 论坛

没有更多推荐了,返回首页