关于vb的多线程的问题!

[hewei1729]

请问高手们,你们在VB里用过多线程吗?用的话把代码贴出来研究研究,本人很需要这方面的知识!在这里先谢谢!(在线等待)

[hewei1729]

各位大吓,没人知道呀,还是不愿意回答?给小弟点提示也行呀!

[balloonman2002]

1、搜索以前VB论坛；
2、搜索WWW.GOOGLE.COM；

[笑对最好]

VB实现多线程

新建一Module
Declare Function CreateThread Lib "kernel32" (lpThreadAttributes As Any, ByVal dwStackSize As Long, ByVal lpStartAddress As Long, lpParameter As Any, ByVal dwCreationFlags As Long, lpThreadID As Long) As Long
Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long

Sub main()
Load Form1
Form1.Show
End Sub
Public Sub c1()
.......
End Sub

Public Sub c2()
......
End Sub

新建一窗体

Private hthread1 As Long
Private hthread2 As Long
Private ithread1 As Long
Private ithread2 As Long

Private Sub Command1_Click()

ithread1 = CreateThread(ByVal 0&, ByVal 0&, AddressOf c1, ByVal 0&, ByVal 0&, hthread1) --创建线程一
ithread2 = CreateThread(ByVal 0&, ByVal 0&, AddressOf c1, ByVal 0&, ByVal 0&, hthread1) --创建线程二

CloseHandle ithread1 --关闭线程一
CloseHandle ithread2 --关闭线程二

End Sub

Private Sub Form_Load()

End Sub

这个好像可以，但是好像结束时会出错！
你在看看！

[笑对最好]

这个多线程的好像比较完善，
不会出错！不过要复杂一些！


在一个工程中添加一个类模块clsThreads，代码如下:
Option Explicit
Option Compare Text
Option Base 0

Private Type udtThread
Handle As Long
Enabled As Boolean
End Type

Private uThread As udtThread

Private Const CREATE_SUSPENDED As Long = &H4
Private Const THREAD_BASE_PRIORITY_IDLE As Long = -15
Private Const THREAD_BASE_PRIORITY_LOWRT As Long = 15
Private Const THREAD_BASE_PRIORITY_MAX As Long = 2
Private Const THREAD_BASE_PRIORITY_MIN As Long = -2
Private Const THREAD_PRIORITY_HIGHEST As Long = THREAD_BASE_PRIORITY_MAX
Private Const THREAD_PRIORITY_LOWEST As Long = THREAD_BASE_PRIORITY_MIN
Private Const THREAD_PRIORITY_ABOVE_NORMAL As Long = (THREAD_PRIORITY_HIGHEST - 1)
Private Const THREAD_PRIORITY_BELOW_NORMAL As Long = (THREAD_PRIORITY_LOWEST + 1)
Private Const THREAD_PRIORITY_IDLE As Long = THREAD_BASE_PRIORITY_IDLE
Private Const THREAD_PRIORITY_NORMAL As Long = 0
Private Const THREAD_PRIORITY_TIME_CRITICAL As Long = THREAD_BASE_PRIORITY_LOWRT

Private Declare Function CreateThread Lib "Kernel32" (ByVal lpThreadAttributes As Any, ByVal dwStackSize As Long, ByVal lpStartAddress As Long, lpParameter As Any, ByVal dwCreationFlags As Long, lpThreadId As Long) As Long
Private Declare Function ResumeThread Lib "Kernel32" (ByVal hThread As Long) As Long
Private Declare Function SetThreadPriority Lib "Kernel32" (ByVal hThread As Long, ByVal nPriority As Long) As Long
Private Declare Function GetThreadPriority Lib "Kernel32" (ByVal hThread As Long) As Long
Private Declare Function SuspendThread Lib "Kernel32" (ByVal hThread As Long) As Long
Private Declare Function TerminateThread Lib "Kernel32" (ByVal hThread As Long, ByVal dwExitCode As Long) As Long
Public Sub Initialize(ByVal lpfnBasFunc As Long)

Dim lStackSize As Long, lCreationFlags As Long, lpThreadId As Long, lNull As Long

On Error Resume Next
lNull = 0
lStackSize = 0
lCreationFlags = CREATE_SUSPENDED
uThread.Handle = CreateThread(lNull, lStackSize, lpfnBasFunc, lNull, lCreationFlags, lpThreadId)
If uThread.Handle = lNull Then MsgBox "Create thread failed!"

End Sub
Public Property Get Enabled() As Boolean

On Error Resume Next
Enabled = uThread.Enabled

End Property
Public Property Let Enabled(ByVal vNewValue As Boolean)

On Error Resume Next
If vNewValue And (Not uThread.Enabled) Then
ResumeThread uThread.Handle
uThread.Enabled = True
ElseIf uThread.Enabled Then
SuspendThread uThread.Handle
uThread.Enabled = False
End If

End Property
Public Property Get Priority() As Long

On Error Resume Next
Priority = GetThreadPriority(uThread.Handle)

End Property
Public Property Let Priority(ByVal vNewValue As Long)

On Error Resume Next
If vNewValue = -2 Then
Call SetThreadPriority(uThread.Handle, THREAD_PRIORITY_LOWEST)
ElseIf vNewValue = -1 Then
Call SetThreadPriority(uThread.Handle, THREAD_PRIORITY_BELOW_NORMAL)
ElseIf vNewValue = 0 Then
Call SetThreadPriority(uThread.Handle, THREAD_PRIORITY_NORMAL)
ElseIf vNewValue = 1 Then
Call SetThreadPriority(uThread.Handle, THREAD_PRIORITY_ABOVE_NORMAL)
ElseIf vNewValue = 2 Then
Call SetThreadPriority(uThread.Handle, THREAD_PRIORITY_HIGHEST)
End If

End Property
Private Sub Class_Terminate()

On Error Resume Next
Call TerminateThread(uThread.Handle, 0)

End Sub

再添加一模块，代码如下：
Option Explicit
Private Declare Function GetTickCount Lib "Kernel32" () As Long

Public Sub C1()

Dim i As Integer
For i = 0 To 1000
Text1.Text = i
Next

End Sub
Public Sub C2()

Dim i As Integer
For i = 1000 To 0 Step -1
Text2.Text = i
Next

End Sub
此为两个进程的代码
在Form中，添加两个TextBox，名字为Text1,Text2.
定义两个线程为clsThreads
dim th1 as new clsThreads
再添加一个Button,在Click事件里面，
初始化线程，并且启动
th1.Initialize AddressOf C1
th1.enable

th2.Initialize AddressOf C2
th2.enable

msgbox "C1 and C2 is runing!"
启动，

如果要中止则
set th1=nothing

[hewei1729]

非常感谢!我要研究研究,等着慌收分吧!

[hewei1729]

我通过测试,程序根本就没有进到C1和C2里,这是怎么回事?

[hewei1729]

Initialize的时候就启动线程了吗?

[jo_yoko]

我这里有一篇关于VB多线程的文章，你可以看看
我们用的第一个API是CreateThread, VB的格式是:

private declare function CreateThread Lib "kernel32" (byval pThreadAttributes as any, byval dwStackSize as long, byval lpStartAddress as long, lpParameter as any, byval dwCreationFlags as long, lpThreadID as long) as long. (从vb API text viewer中拿是最真确的语法)

CreateThread的参数指出你将要创立的县城是什么样子的. CreateThread的返回值是一个县城的handle. 这里是vb的多县城初始化程序:

Public Sub Initialize(lpfnBasFunc as long)
dim dwStackSize as long
dim dwCreationFlags as long
dim lpThreadId as long
dim lpParameter as long
dim myNull as long
myNull = 0& ’create a null pointer
dwStackSize = 0 ’0表示用exe stack size
dwCreationFlags = 4 ’用4表示初始化后先不激活,让别人来激活.
Me.Thread = CreateThread(myNull, dwStackSize, lpfnBasFunc, myNull, dwCreationFlags, lpThreadId)
if Me.Thread = myNull then
Msgbox "create thread failed"
end if
end Sub
下面是两个API用来激活/暂定该线程.

private declare function ResumeThread lib "kernel32"(byval hThread as long)as longprivate declare function SuspendThread lib "kernel32"(byval hThread as long)as long

让我们来用一个变量表示当前县城的状态.
public ThreadStatus as boolean
在vb里,可用property来实现ThreadStatus的管理.


Public property Let Enabled(byval vNewValue as boolean)
if vNewValue = true and Me.ThreadStatus = false then
ResumeThread Me.Thread
Me.ThreadStatus = True
elseif Me.ThreadStatus = true then
SuspendThread Me.Thread
Me.ThreadStatus = False
endif
end Property

这个简单的类可以用New Object来引用:
’make new thread object
dim myThread as New clsThreads
’创建县城 Foo
myThread.Initialize AddressOf Foo
’激活县城
myThread.Enabled = True

执行后,你可以用PVIEW95.EXE看到你的线程.
你还可以提高你的线程的优先级.
SetThreadPriority ’设优先级GetThreadPriority ’查优先级

你把以上的程序加入timer例子,就会看到两个timer同时运行.
这里要提醒一下.如果你的程序写错,或中断后试图恢复,往往会出错,有时是GPF错

[hewei1729]

谢谢!

[zhuangbx220]

如果你没搞定,,,说明你没认真,,,, 我试过了很正常!

VB 多线程

'-------------Form-----------------------------------------
Option Explicit
Private Sub Command1_Click()

Dim myThreadTop As New clsThreads, myThreadBottom As New clsThreads

On Error Resume Next
With myThreadTop
.Initialize AddressOf FlickerTop
.Enabled = True
End With
With myThreadBottom
.Initialize AddressOf FlickerBottom
.Enabled = True
End With

MsgBox "Let's wait and see what happens..."

Set myThreadTop = Nothing
Set myThreadBottom = Nothing

End Sub
''''''''''''''''''''''''''''''''''''''''''''''''
'---------clsThreads----Class----------------------
Option Explicit
Option Compare Text
Option Base 0

Private Type udtThread
Handle As Long
Enabled As Boolean
End Type

Private uThread As udtThread

Private Const CREATE_SUSPENDED As Long = &H4
Private Const THREAD_BASE_PRIORITY_IDLE As Long = -15
Private Const THREAD_BASE_PRIORITY_LOWRT As Long = 15
Private Const THREAD_BASE_PRIORITY_MAX As Long = 2
Private Const THREAD_BASE_PRIORITY_MIN As Long = -2
Private Const THREAD_PRIORITY_HIGHEST As Long = THREAD_BASE_PRIORITY_MAX
Private Const THREAD_PRIORITY_LOWEST As Long = THREAD_BASE_PRIORITY_MIN
Private Const THREAD_PRIORITY_ABOVE_NORMAL As Long = (THREAD_PRIORITY_HIGHEST - 1)
Private Const THREAD_PRIORITY_BELOW_NORMAL As Long = (THREAD_PRIORITY_LOWEST + 1)
Private Const THREAD_PRIORITY_IDLE As Long = THREAD_BASE_PRIORITY_IDLE
Private Const THREAD_PRIORITY_NORMAL As Long = 0
Private Const THREAD_PRIORITY_TIME_CRITICAL As Long = THREAD_BASE_PRIORITY_LOWRT

Private Declare Function CreateThread Lib "kernel32" (ByVal lpThreadAttributes As Any, ByVal dwStackSize As Long, ByVal lpStartAddress As Long, lpParameter As Any, ByVal dwCreationFlags As Long, lpThreadId As Long) As Long
Private Declare Function ResumeThread Lib "kernel32" (ByVal hThread As Long) As Long
Private Declare Function SetThreadPriority Lib "kernel32" (ByVal hThread As Long, ByVal nPriority As Long) As Long
Private Declare Function GetThreadPriority Lib "kernel32" (ByVal hThread As Long) As Long
Private Declare Function SuspendThread Lib "kernel32" (ByVal hThread As Long) As Long
Private Declare Function TerminateThread Lib "kernel32" (ByVal hThread As Long, ByVal dwExitCode As Long) As Long
Public Sub Initialize(ByVal lpfnBasFunc As Long)

Dim lStackSize As Long, lCreationFlags As Long, lpThreadId As Long, lNull As Long

On Error Resume Next
lNull = 0
lStackSize = 0
lCreationFlags = CREATE_SUSPENDED
uThread.Handle = CreateThread(lNull, lStackSize, lpfnBasFunc, lNull, lCreationFlags, lpThreadId)
If uThread.Handle = lNull Then MsgBox "创建线程失败!"

End Sub
Public Property Get Enabled() As Boolean

On Error Resume Next
Enabled = uThread.Enabled

End Property
Public Property Let Enabled(ByVal vNewValue As Boolean)

On Error Resume Next
If vNewValue And (Not uThread.Enabled) Then
ResumeThread uThread.Handle
uThread.Enabled = True
ElseIf uThread.Enabled Then
SuspendThread uThread.Handle
uThread.Enabled = False
End If

End Property
Public Property Get Priority() As Long

On Error Resume Next
Priority = GetThreadPriority(uThread.Handle)

End Property
Public Property Let Priority(ByVal vNewValue As Long)

On Error Resume Next
If vNewValue = -2 Then
Call SetThreadPriority(uThread.Handle, THREAD_PRIORITY_LOWEST)
ElseIf vNewValue = -1 Then
Call SetThreadPriority(uThread.Handle, THREAD_PRIORITY_BELOW_NORMAL)
ElseIf vNewValue = 0 Then
Call SetThreadPriority(uThread.Handle, THREAD_PRIORITY_NORMAL)
ElseIf vNewValue = 1 Then
Call SetThreadPriority(uThread.Handle, THREAD_PRIORITY_ABOVE_NORMAL)
ElseIf vNewValue = 2 Then
Call SetThreadPriority(uThread.Handle, THREAD_PRIORITY_HIGHEST)
End If

End Property
Private Sub Class_Terminate()

On Error Resume Next
Call TerminateThread(uThread.Handle, 0)

End Sub
'------------------------------------------------------------
'--------------Module-------------------------------------------
Option Explicit
Private Declare Function GetTickCount Lib "kernel32" () As Long
Public Sub FlickerTop()

Static BgColor As Long
Dim lTick As Long, lCounter As Long

On Error Resume Next
For lCounter = 0 To 5999
If BgColor <> &HFF& Then BgColor = &HFF& Else BgColor = &HFF00&
Form1.Picture1.BackColor = BgColor
lTick = GetTickCount
While GetTickCount - lTick < 1250
Wend
Next

End Sub
Public Sub FlickerBottom()

Static BgColor As Long
Dim lTick As Long, lCounter As Long

On Error Resume Next
For lCounter = 0 To 5999
If BgColor <> &HFFFF& Then BgColor = &HFFFF& Else BgColor = &HFF0000
Form1.Picture2.BackColor = BgColor
lTick = GetTickCount
While GetTickCount - lTick < 500
Wend
Next

End Sub

[public]

xue xi

[ItSeeker]

zhuangbx220(星)：你的代码编译成exe，就崩溃了，建议不要在VB中用多线程，易出错啊！

[ItSeeker]

VB中CreateThread很不稳定，可以用VC写多线程DLL让VB调用

[xqchang]

用VB.Net吧，很简单！

[dsclub]

算了吧，VB做多线程也就是自己练练技术，千万别发布给客户，否则丢了工作。呵呵……

[hewei1729]

哪里有VB.Net的资料可以下呀

[tanzheng]

zhuangbx220(星)：你的代码编译成exe，就崩溃了，建议不要在VB中用多线程，易出错啊！
这是由于里面在 GetTickCount 这个api 原因
还有在用多线程时最好不要用 picture
还有这个根本不叫多线程呀，我想请问这位兄台如如果我 主程序要干别的事怎么办
呀，这个程序好像只能利用 msgbox 来挡住主程序不能向下执行呀，如现有要按某的键一干另外的事怎么办，请指点。

[tanzheng]

补充一点
在 VB 里编多线程一定要生成 EXE 然后在 WINDOWS 下运行这样才不会出问题

[nik_Amis]

up