VB中的多线程

 VB中实现多线程可用如下两种方法：

 

方法一：创建本身支持多线程的程序。

1、创建一个Activex EXE工程，工程名为ThreadPro，在工程属性中，线程模型（Thread model）选择Thread per object，启动方式（Start mode）选择Standalone，启动对象（Start object）选择Sub Main。

2、创建一个Form：frmWork，放一个Timer：tmrWork，工作线程将工作在这个Timer的定时器函数中。注意该窗体的Visible属性为False。

3、创建一个工作线程类，比如clsMT，其Instancing设置为MultiUse。通过CreateObject创建的clsMT对象拥有一个独立的线程。clsMT的代码如下：

 

Option Explicit Public Event WorkProcess(index As Long) Dim WithEvents workTimer As Timer Dim frmTmp As frmWork Public Sub StartThread() workTimer.Enabled = True End Sub Private Sub Class_Initialize() Set frmTmp = New frmWork Set workTimer = frmWork.tmrWork End Sub Private Sub Class_Terminate() Set frmTmp = Nothing End Sub Private Sub workTimer_Timer() workTimer.Enabled = False Call ThreadProc '线程处理函数 workTimer.Enabled = True End Sub Private Sub ThreadProc() Dim i as Long For i=0 to 9999999999 If i Mod 1000000000 = 0 Then RaiseEvent WorkProcess(i) End If Next End Sub

 

4、创建一个主界面窗口frmMain，添加一个按钮cmdStart和一个文本框Text1，该窗体的代码如下：

 

Option Explicit Dim WithEvents thread As ThreadPro.clsMT Private Sub cmbStart_Click() Set thread = CreateObject("ThreadPro.clsMT") '这里必须用CreateObject，不能用New thread.StartThread End Sub Private Sub Form_Unload(Cancel As Integer) Set thread = Nothing Quit '下一步再看这个Quit做什么 End Sub Private Sub thread_WorkProcess(index As Long) Text1.Text = CStr(index) End Sub

 

5、Activex EXE运行需要Sub Main函数。创建一个标准模块basMain，添加Sub Main函数，这里要注意一点每次CreateObject创建类实例都会调用Main函数，因此要写代码避免主窗体的重复创建，basMain模块的代码如下。现在知道上一步骤中的Quit干什么用的了吧。

 

Option Explicit Private Declare Function CreateEvent Lib "kernel32.dll" Alias "CreateEventA" ( _ ByVal lpEventAttributes As Long, _ ByVal bManualReset As Long, _ ByVal bInitialState As Long, _ ByVal lpName As String) As Long Private Declare Function OpenEvent Lib "kernel32.dll" Alias "OpenEventA" ( _ ByVal dwDesiredAccess As Long, _ ByVal bInheritHandle As Long, _ ByVal lpName As String) As Long Private Declare Function CloseHandle Lib "kernel32.dll" ( _ ByVal hObject As Long) As Long Private Declare Sub ExitProcess Lib "kernel32.dll" ( _ ByVal uExitCode As Long) Private Const STANDARD_RIGHTS_REQUIRED As Long = &HF0000 Private Const SYNCHRONIZE As Long = &H100000 Private Const EVENT_MODIFY_STATE As Long = &H2 Private Const EVENT_ALL_ACCESS As Long = (STANDARD_RIGHTS_REQUIRED Or SYNCHRONIZE Or &H3) Private Const MyEvent As String = "multi_thread" Dim hEvent As Long Sub Main() If GetEventHandle = 0 Then hEvent = CreateEvent(0&, False, False, MyEvent) frmMain.Show End If End Sub Private Function GetEventHandle() As Long GetEventHandle = OpenEvent(EVENT_ALL_ACCESS, False, MyEvent) Call CloseHandle(GetEventHandle) End Function Public Function Quit() Call CloseHandle(hEvent) End Function

 

6、代码写好，可以运行看效果了。注意在调试状态下是看不到多线程效果的，需要编译为exe后独立运行程序才行。按下cmdStart按钮后，主界面应该不会阻塞，这就是多线程了。（VC中再简单不过的事情在VB中这么费劲！！！）

 

 

方法二：创建执行线程模块。

1、创建一个Activex EXE工程，工程名为ThreadModule，和“方法一”一样在工程属性中，线程模型（Thread model）选择Thread per object，不同的是启动方式（Start mode）选择Activex Compoment，启动对象（Start object）选择None。

2、创建一个Form：frmWork，放一个Timer：tmrWork，工作线程将工作在这个Timer的定时器函数中。注意该窗体的Visible属性为False。

3、创建一个工作线程类，比如clsMT，其Instancing设置为MultiUse。clsMT的代码如下：

 

Option Explicit Public Event WorkProcess(index As Long) Dim WithEvents workTimer As Timer Dim frmTmp As frmWork Public Sub StartThread() workTimer.Enabled = True End Sub Private Sub Class_Initialize() Set frmTmp = New frmWork Set workTimer = frmWork.tmrWork End Sub Private Sub Class_Terminate() Set frmTmp = Nothing End Sub Private Sub workTimer_Timer() workTimer.Enabled = False Call ThreadProc '线程处理函数 workTimer.Enabled = True End Sub Private Sub ThreadProc() Dim i as Long For i=0 to 9999999999 If i Mod 1000000000 = 0 Then RaiseEvent WorkProcess(i) End If Next End Sub

 

4、编译工程，生成ThreadModule.exe。线程模块做好了，别的工程需要多线程时可以引用该模块，具体方法是Project->References，选择ThreadModule，如果列表中没有请单击Browse在文件夹中查找ThreadModule.exe。假设工程有窗体frmData，该窗体需要一个线程，则可以按如下代码启动线程：

 

Option Explicit Dim WithEvents thread As ThreadPro.clsMT Private Sub cmbStart_Click() Set thread = CreateObject("ThreadPro.clsMT") '这里必须用CreateObject，不能用New thread.StartThread End Sub Private Sub Form_Unload(Cancel As Integer) Set thread = Nothing End Sub Private Sub thread_WorkProcess(index As Long) ' ... 线程处理函数 End Sub