查看了很多论坛资料，多线程一直有点迷茫。因历史原因，我们的订单数据非常零散，现在通过后台SQL视图的形式在读取最新订单数据，用openQQ实现数据的同步刷新。因为是后台视图，不能用普通的行重载，追加数据的方式来更新前台数据，用SQLfind找到最新后台数据，与现前台数据对比，更新或加载，发现一人保存时，其它人哪里更新前台会造成窗口假死，啥也操作不了，非常影响操作体验，思考原因，主要是ReceivedMessage 是一条一条执行的，与循环语句一样，这时反复的用SQLfind非常耗费资源，速度变慢。为解决这个问题，就想用多线程来解决这个问题，因为要更新前台表，看论坛一定要用队列。根据论坛例子，我写了如下语句，但发现有压入队列，但队列操作和订单填写没有执行，请帮助修改。
全局代码如下：
'*******订单计划一览表多线程************
Public Sub setqddhtxx(ByVal obj As Object) '取订单计划一览表后台信息
functions. Execute("取订单后台信息", obj)
End Sub
Public _MyQueue As Queue(Of System.Data.DataRow) '定义的表队列
Public _TPool As System.Threading.ThreadPool '定义的线程
'定义一个方法,用于线程委托
'此处可以传参,为了方便,没写.
Public Sub ddd(ByVal obj As Object)
Functions.Execute("队列操作")
End Sub
''' <summary>
''' 委托体
''' </summary>
''' <param name="FunName">自定义函数名</param>
''' <param name="obj">传入参数</param>
''' <param name="OutObj">返回值</param>
''' <remarks></remarks>
Public Delegate Function _Delegate(ByVal FunName As String,ByVal obj() As Object) As Object
'委托的处理方法
'根据狐表的自定义函数,定义一个通用的委托方法,便于调用
Public Function _MyDelegateMethod(ByVal FunName As String, ByVal ParamArray obj() As Object) As Object
Return Foxtable.Functions.Execute(FunName, obj)
End Function
'****************************
内部函数如下：
取订单后台信息：
Dim xsdh As String = Args(0)
Dim dr As DataRow = DataTables("订单计划一览表后台").SQLFind("销售单号 = '" & xsdh & "'")
Dim htdr As System.Data.DataRow
'对像压入队列
If _MyQueue IsNot Nothing Then
_MyQueue.Clear '不为空,清空
Else
_MyQueue = New Queue(of System.Data.DataRow) '为空,初始化
End If
If dr IsNot Nothing Then
'MessageBox.Show("有取后台")
htdr = dr.baseRow
_MyQueue.Enqueue(htdr)
Vars("逻辑1") += 2
End If
htdr = Nothing
Return Nothing
队列操作：
If Vars("逻辑1") > 0 AndAlso _MyQueue IsNot Nothing AndAlso _MyQueue.Count > 0 Then
Dim dr As System.Data.DataRow = _MyQueue.Dequeue '获取队列的第一个值
'执行自己的逻辑代码
MessageBox.Show("队列操作有")
'委托执行函数(BaseMainForm应该是主线程的窗口,所以调用他用来在主线程中执行代码)
BaseMainForm.Invoke(New _Delegate(AddressOf _MyDelegateMethod), "订单填写",New Object(){dr})
Threading.Thread.CurrentThread.Sleep(200) '模拟事务的执行过程
Vars("逻辑1") += 1 '通知执行下一个任务
Else
Vars("逻辑1") = -1
End If
订单填写：
Dim htdr As System.Data.DataRow =Args(0)
Dim dr As DataRow = DataTables("订单计划一览表").Select("销售单号 = '"& htdr("销售单号") &"'")(0)
If dr IsNot Nothing Then
MessageBox.Show("订单填写有")
'加载更新项
Dim sfxgpd As Boolean = False
For Each dc As DataCol In DataTables("订单计划一览表").DataCols
Dim key As String = "订单计划一览表:" & dr("销售单号") & ":" & dc.Name
If tbrk.Contains(key) = False Then '如果本人之前已经编辑此行,则正常编辑
If dc.IsDate Then
If htdr(dc.Name) = #1/1/1900# Then
dr(dc.Name) = Nothing
End If
Else If dc.Name = "操作记录" Then
If htdr.IsNull(dc.Name) = False Then
If dr.IsNull(dc.Name) Then
dr(dc.Name) = htdr(dc.Name)
Else
If dr(dc.Name) <> htdr(dc.Name) Then
dr(dc.Name) = dr(dc.Name) & htdr(dc.Name)
End If
End If
End If
Else
If dr(dc.Name) <> htdr(dc.Name) Then
dr(dc.Name) = htdr(dc.Name)
End If
End If
Else
sfxgpd = True
End If
Next
If sfxgpd = False Then
dr.Save()
End If
Else
Dim ndr As DataRow = DataTables("订单计划一览表").AddNew() '没有时追加行
For Each dc As DataCol In DataTables("订单计划一览表").DataCols
ndr(dc.Name) = htdr(dc.Name)
If dc.IsDate Then
If ndr(dc.Name) = #1/1/1900# Then
ndr(dc.Name) = Nothing
End If
End If
Next
ndr.Save()
End If
Return Nothing
收到来自好友或服务器的信息时触发ReceivedMessage代码如下：
Dim msg As String = e.Message
If msg.StartsWith("U#") Then '表示修改了某行
Dim pts() As String = msg.Split("#")
If pts.Length = 3 Then
If DataTables.Contains(pts(1)) Then
If pts(1) = "订单计划一览表" AndAlso Forms("订单计划一览表").Opened = True Then
Dim t1 As Threading.Thread
t1 = New Threading.Thread(AddressOf setqddhtxx)
t1.Start(pts(2))
end if
end if
end if
end if
加好友 
发短信
Post By：2018/1/18 9:19:00 [只看该作者]
