发表于：2004/12/3 14:50:00
#10楼
我摘的，自己看！！！！！！！！！
VB中轻松实现多线程
substance
" 我们在用VB写程序的时候，可能会碰到这样的情况，就是在一个无限的循环之外，我们还希望程序能完成一些其他的工作。例如，我们要编写一个实时监视注册表的程序，需要用到一个无限的等待循环来监视注册表键值的变化(可以用函数WaitForSingleObject来实现)，但是一旦程序进入这个无限的循环等待当中，就再也无法执行其他任务，也不能响应任何事件了(除非该函数监测到注册表键值发生变化而退出循环)。到底有没有办法解决这个问题呢？回答当然是肯定的，只要把这个无限循环单独放在一个线程中，问题就迎刃而解了。可是这又涉及到了一个如何创建多线程的问题。可能大家以为创建多个线程很困难吧，其实不是这样的。
在VB中用addressof操作符，再加上一些Windows API函数，就可以轻易地实现多线程。用VB做的多线程比用C++简单得多，而且做出来的速度一样快，因为它们都使用Windows API。每一个线程占用大约20毫秒时间片。
用VB写多线程程序用到的第一个API函数是CreateThread，这个函数的声明如下：
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
这个函数的返回值是线程的句柄，它的参数含义如下：
1.lpThreadAttributes：这个参数表明函数的返回句柄是否可被子进程继承，如果可被继承，则指向一个SECURITY_ATTRIBUTES的结构，否则设为vbnull。
2.dwStackSize：这个参数设置线程的堆栈大小。
3.lpStartAddress：这个参数指明这个线程函数的起始地址。
4.lpParameter：这个参数是传给线程函数的参数。
5.dwCreationFlags：这个参数设置当线程创建时的初始状态，挂起，运行等等。
6.lpThreadId：这个参数是待创建线程的ID号。
假设创建一个管理线程的类clsThreads，用类的一个公用函数Initialize来初始化线程，用ResumeThread和SuspendThread函数来激活线程，实现代码如下：
Private Type udtThread
Handle As Long
Enabled As Boolean
End Type
Private uThread As udtThread
Private Const CREATE_SUSPENDED As Long = &H4
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 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 '0表示用exe的stack size
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
Private Sub Class_Terminate() '终止线程
On Error Resume Next
Call TerminateThread(uThread.Handle, 0)
End Sub
以上内容在类模块clsThreads中，有了它就可以在窗体中实现多线程了。下面以一个简单的例子来说明如何创建多线程(以2个线程为例)。
在form1中添加picture1和picture2两个图片框，以及一个command1按钮，在工程中添加一个bas模块，该模块的代码如下：
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 60000
BgColor = lCounter Mod 256
Form1.Picture1.BackColor = RGB(BgColor, 0, 0) '变化图片框的颜色
lTick = GetTickCount
While GetTickCount - lTick < 10 '延迟10个毫秒时间
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 60000
BgColor = lCounter Mod 256
Form1.Picture2.BackColor = RGB(0, BgColor, 0)
lTick = GetTickCount
While GetTickCount - lTick < 10
Wend
Next
End Sub
最后在form1中用下面的代码来创建两个线程，
Option Explicit
Public myThreadTop As New clsThreads, myThreadBottom As New clsThreads
Private Sub Command1_Click()
On Error Resume Next
With myThreadTop
.Initialize AddressOf FlickerTop
.Enabled = True
End With
With myThreadBottom
.Initialize AddressOf FlickerBottom
.Enabled = True
End With
MsgBox ""看看会有什么...""
Set myThreadTop = Nothing
Set myThreadBottom = Nothing
End Sub
代码很简单，程序运行的结果是出现两个颜色不断变化的图片框(注意，两个图片框的颜色是同时变化的，而且分别各处在一个循环当中，即两个循环同时进行)，但是必须记住的一点就是程序退出之前一定要结束所创建的线程，不然就会出现非法操作之类的错误。多线程的应用还有很多，用途是十分广泛的，上面举到的一些例子只是多线程应用的极小一部分，更多的东西还需要大家在实践中积累得到。(文中程序在Windows98+VB6.0下调试通过)
VB中轻松实现多线程
substance
" 我们在用VB写程序的时候，可能会碰到这样的情况，就是在一个无限的循环之外，我们还希望程序能完成一些其他的工作。例如，我们要编写一个实时监视注册表的程序，需要用到一个无限的等待循环来监视注册表键值的变化(可以用函数WaitForSingleObject来实现)，但是一旦程序进入这个无限的循环等待当中，就再也无法执行其他任务，也不能响应任何事件了(除非该函数监测到注册表键值发生变化而退出循环)。到底有没有办法解决这个问题呢？回答当然是肯定的，只要把这个无限循环单独放在一个线程中，问题就迎刃而解了。可是这又涉及到了一个如何创建多线程的问题。可能大家以为创建多个线程很困难吧，其实不是这样的。
在VB中用addressof操作符，再加上一些Windows API函数，就可以轻易地实现多线程。用VB做的多线程比用C++简单得多，而且做出来的速度一样快，因为它们都使用Windows API。每一个线程占用大约20毫秒时间片。
用VB写多线程程序用到的第一个API函数是CreateThread，这个函数的声明如下：
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
这个函数的返回值是线程的句柄，它的参数含义如下：
1.lpThreadAttributes：这个参数表明函数的返回句柄是否可被子进程继承，如果可被继承，则指向一个SECURITY_ATTRIBUTES的结构，否则设为vbnull。
2.dwStackSize：这个参数设置线程的堆栈大小。
3.lpStartAddress：这个参数指明这个线程函数的起始地址。
4.lpParameter：这个参数是传给线程函数的参数。
5.dwCreationFlags：这个参数设置当线程创建时的初始状态，挂起，运行等等。
6.lpThreadId：这个参数是待创建线程的ID号。
假设创建一个管理线程的类clsThreads，用类的一个公用函数Initialize来初始化线程，用ResumeThread和SuspendThread函数来激活线程，实现代码如下：
Private Type udtThread
Handle As Long
Enabled As Boolean
End Type
Private uThread As udtThread
Private Const CREATE_SUSPENDED As Long = &H4
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 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 '0表示用exe的stack size
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
Private Sub Class_Terminate() '终止线程
On Error Resume Next
Call TerminateThread(uThread.Handle, 0)
End Sub
以上内容在类模块clsThreads中，有了它就可以在窗体中实现多线程了。下面以一个简单的例子来说明如何创建多线程(以2个线程为例)。
在form1中添加picture1和picture2两个图片框，以及一个command1按钮，在工程中添加一个bas模块，该模块的代码如下：
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 60000
BgColor = lCounter Mod 256
Form1.Picture1.BackColor = RGB(BgColor, 0, 0) '变化图片框的颜色
lTick = GetTickCount
While GetTickCount - lTick < 10 '延迟10个毫秒时间
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 60000
BgColor = lCounter Mod 256
Form1.Picture2.BackColor = RGB(0, BgColor, 0)
lTick = GetTickCount
While GetTickCount - lTick < 10
Wend
Next
End Sub
最后在form1中用下面的代码来创建两个线程，
Option Explicit
Public myThreadTop As New clsThreads, myThreadBottom As New clsThreads
Private Sub Command1_Click()
On Error Resume Next
With myThreadTop
.Initialize AddressOf FlickerTop
.Enabled = True
End With
With myThreadBottom
.Initialize AddressOf FlickerBottom
.Enabled = True
End With
MsgBox ""看看会有什么...""
Set myThreadTop = Nothing
Set myThreadBottom = Nothing
End Sub
代码很简单，程序运行的结果是出现两个颜色不断变化的图片框(注意，两个图片框的颜色是同时变化的，而且分别各处在一个循环当中，即两个循环同时进行)，但是必须记住的一点就是程序退出之前一定要结束所创建的线程，不然就会出现非法操作之类的错误。多线程的应用还有很多，用途是十分广泛的，上面举到的一些例子只是多线程应用的极小一部分，更多的东西还需要大家在实践中积累得到。(文中程序在Windows98+VB6.0下调试通过)
