【VFB】多线程（VFB教程3-3）

勇芳软件 · 发表于 2018-2-26 22:48:24

欢迎访问技术宅的结界，请注册或者登录吧。

您需要登录才可以下载或查看，没有账号？立即注册→加入我们

×

此处为VisualFreeBasic编程教程(从零开始学或VB进阶)的子章节部分，全部目录点链接。
使用多线程非常简单，就如同调用本地过程一样

ThreadDetach ThreadCreate(@abc,0) '经典调用方法 -------------------------------------------------
sub abc(aa as long) '线程标准写法 .....
end sub

复制代码

ThreadCreate 创建线程，会返回线程句柄
只可以传1个参数给线程，线程句柄不用后，必须释放，就用 ThreadDetach ，只是释放句柄，但不会终止线程
有个 ThreadWait 是等待线程完成，才执行下一行，除非特殊情况，不然失去了多线程的意义，很少用到。
还有个种方法创建线程，可以带多个参数

''线程使用“ThreadCall”
Sub thread( id As String, tlock As Any Ptr, count As Integer )
For i As Integer = 1 To count
MutexLock tlock
Print "线" & id;
Locate , 20
Print i & "/" & count
MutexUnlock tlock
Next
End Sub
Dim tlock As Any Ptr = MutexCreate()
Dim a As Any Ptr = ThreadCall thread("A", tlock, 6)
Dim b As Any Ptr = ThreadCall thread("B", tlock, 4)
ThreadWait a
ThreadWait b
MutexDestroy tlock
Print "全部完成（并且没有Dim Shared！）"

复制代码

使用Threadcall是创建线程的更简单的方法，并允许将数据传递到线程，而不会有全局变量或不是类型安全的指针。但是，ThreadCreate更有效率，应该用于创建大量线程的程序。

Function IsThreadAlive(ByVal dwThread As HANDLE ) As BOOL
'判断线程句柄是否被终止 , 如果终止返回FALSE,如果还活着返回TRUE
Dim bRet As BOOL ,ExitCode As Ulong
If GetExitCodeThread(dwThread,@ExitCode) Then
If ExitCode = STILL_ACTIVE Then bRet = True
End If
Return bRet
End Function
’此函数已经在VFB函数库里，不需要自己创建，直接调用

复制代码

有时需要知道，线程是不是活着还是终止，就用以上函数

Dim cc As HANDLE Ptr '线程指针
cc= ThreadCreate(@abc,0) '经典调用方法
If IsThreadAlive(*cc) Then '*CC 取出的是线程句柄
End If
Threaddetach cc '释放线程句柄
-------------------------------------------------
sub abc(aa as long) '线程标准写法
.....
end sub

复制代码

假如，有多个线程使用的全局变量，那么，就可能发生问题了，1个读1个写。

（如果是单个数字变量，可以不用考虑，字符串、数组等，肯定出问题）
用MutexCreate创建个互斥体来，读写全局变量时用MutexLock锁定，过后用MutexUnlock解锁。

'使用Mutex进行线程同步的可视示例：
'“用户定义的线程”计算圆上的点坐标，
'和“主线程”绘制点数。
'
'如果你注释掉包含“MutexLock”和“MutexUnlock”的行
'（在“用户定义的线程”或/和“主线程”内），
'两个线程（“用户定义”和“主”）将不会同步，
'并且许多点不会在圆上绘制（由于非相干坐标）。
'-----------------------------------------------------------------------------------------------------
Type ThreadUDT '通用用户线程UDT
Dim handle As Any Ptr '任何用户线程的Ptr句柄
Dim sync As Any Ptr '互斥体的任何Ptr句柄
Dim quit As Byte '布尔到最终用户线程
Declare Static Sub Thread (ByVal As Any Ptr) '通用用户线程程序
Dim procedure As Sub (ByVal As Any Ptr) '用户线程执行的过程（任何Ptr）
Dim p As Any Ptr '任何Ptr传递给用户线程执行的过程
Const false As Byte = 0 '常数“假”
Const true As Byte = Not False '康斯坦丁“真”
End Type
Static Sub ThreadUDT.Thread (ByVal param As Any Ptr) '通用用户线程程序
Dim tp As ThreadUDT Ptr = param '转换为通用用户线程UDT
Do
MutexLock(tp->sync) '互斥（锁定）用户线程
tp->procedure(tp->p) '用户线程执行的过程（任何Ptr）
MutexUnlock(tp->sync) 'Mutex（解锁）用户线程
Sleep 5
Loop Until tp->quit = tp->true '测试结束用户线程
End Sub
'-----------------------------------------------------------------------------------------------------
Type Point2D
Dim x As Integer
Dim y As Integer
End Type
Const x0 As Integer = 640 / 2
Const y0 As Integer = 480 / 2
Const r0 As Integer = 200
Const pi As Single = 4 * Atn(1)
Sub PointOnCircle (ByVal p As Any Ptr)
Dim pp As Point2D Ptr = p
Dim teta As Single = 2 * pi * Rnd
pp->x = x0 + r0 * Cos(teta)
Sleep 5 '增加不相关的数据发生的可能性
pp->y = y0 + r0 * Sin(teta)
End Sub
Screen 12
Locate 30, 2
Print "<any_key >：exit";
Dim Pptr As Point2D Ptr = New Point2D
Pptr->x = x0 + r0 * Cos(0)
pptr->y = y0 + r0 * Sin(0)
Dim Tptr As ThreadUDT Ptr = New ThreadUDT
Tptr->sync = MutexCreate
Tptr->procedure = @PointOnCircle
Tptr->p = Pptr
Tptr->handle = ThreadCreate(@ThreadUDT.Thread, Tptr)
Do
MutexLock(Tptr->sync) '用于主线程的互斥（锁定）
PSet (Pptr->x, Pptr->y)
MutexUnlock(Tptr->sync) 'Mutex（解锁）主线程
Sleep 5
Loop Until Inkey <> ""
Tptr->quit = Tptr->true
ThreadWait(Tptr->handle)
MutexDestroy(Tptr->sync)
Delete Tptr
Delete Pptr

复制代码

非有必要，多个线程还是不要用全局变量为好，因为那样，老是在互相等待中，失去了多线程的同时运行的意义。

海南怪人 · 发表于 2020-2-18 09:08:56

能力有限看不懂！

xiawan · 发表于 2022-5-13 16:56:55

论坛有你真的精彩~

aguai2008 · 发表于 2023-4-20 00:10:41

没有研究过~~~

0xAA55 · 发表于 2023-4-22 20:54:52

我看到你有互斥锁，那么更底层的原子操作应该也有吧？原子操作的代码也展示一下不

账号		自动登录	找回密码
密码			立即注册→加入我们

【VFB】多线程（VFB教程3-3）

欢迎访问技术宅的结界，请注册或者登录吧。

相关帖子