增加一个窗体,将它命名为 frmProcess ,并将其 Visible 和 ControlBox 属性设成 False 。 这个窗体将以隐藏窗口的方式运行,其中 Sub Main 用来标识该进程的主线程。这个窗体不需要代码。
在工程中增加一个标准模块。把声明、 Sub Main 过程、以及下面显示的 EnumThreadWndMain 过程放在这个模块中。正如在相应的文字和代码注释中所说明的,在启动应用程序以及每次创建一个新的线程时,都要执行 Sub Main 。 Sub Main 的示例代码演示了如何标识第一个线程,这样就能知道何时创建 MainApp。
在 Sub Main 中决定主线程
每个新的线程都会执行 Sub Main 。这是因为 Visual Basic 为每个线程(即每个单元)都维护了一个全局数据的独立副本。为了初始化线程的全局数据,必须执行 Sub Main 。这就是说如果 Sub Main 加载了一个隐藏的窗口,或者显示了应用程序的主用户界面,那么在创建每个新线程时都会加载这些窗体的新副本。
下面的代码用来判断 Sub Main 是不是在第一个线程中执行,这样可以只加载一次隐藏的窗体或者只显示一次测试应用程序的主用户界面。
' 被隐藏窗口的标题的根值
Public Const PROC_CAPTION = "ApartmentDemoProcessWindow"
Public Const ERR_InternalStartup = &H600
Public Const ERR_NoAutomation = &H601
Public Const ENUM_STOP = 0
Public Const ENUM_CONTINUE = 1
Declare Function FindWindow Lib "user32" Alias "FindWindowA" _
(ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Declare Function GetWindowThreadProcessId Lib "user32"_
(ByVal hwnd As Long, lpdwProcessId As Long) As Long
Declare Function EnumThreadWindows Lib "user32" _
(ByVal dwThreadId As Long, ByVal lpfn As Long, ByVal lParam As Long) _
As Long
' 通过 EnumThreadWindows 取得窗口句柄。
Private mhwndVB As Long
' 用来标识主线程的隐藏窗体。
Private mfrmProcess As New frmProcess
' 进程标识符。
Private mlngProcessID As Long
Sub Main()
Dim ma As MainApp
' 借用一个窗口句柄来获得进程
' 标识符(请参阅下面 EnumThreadWndMain 的回调)。
Call EnumThreadWindows(App.ThreadID, AddressOf EnumThreadWndMain, 0&)
If mhwndVB = 0 Then
Err.Raise ERR_InternalStartup + vbObjectError, , _
"Internal error starting thread"
Else
Call GetWindowThreadProcessId(mhwndVB, mlngProcessID)
' 进程标识符使隐藏窗口的标题具有唯一性。
If 0 = FindWindow(vbNullString, PROC_CAPTION & CStr(mlngProcessID)) Then
' 找不到窗口,因此这是第一个线程。
If App.StartMode = vbSModeStandalone Then
' 用唯一的标题创建隐藏窗体。
mfrmProcess.Caption = PROC_CAPTION & CStr(mlngProcessID)
' MainApp 的初始化事件( Instancing =
' PublicNotCreatable )显示主用户界面。
Set ma = New MainApp
' (如果没有对 MainApp 的全局引用,那么
' 关闭应用程序就更加简单;否则 MainApp 应该
' 把 Me 传递给主用户窗体,这样
' 该窗体就能保证 MainApp 不被终止。)
Else
Err.Raise ERR_NoAutomation + vbObjectError, , _
"Application can't be started with Automation"
End If
End If
End If
End Sub
' EnumThreadWindows 所使用的回调函数。
Public Function EnumThreadWndMain(ByVal hwnd As Long, ByVal _
lParam As Long) As Long
' 保存窗口句柄。
mhwndVB = hwnd
' 只需要第一个窗口。
' 一发现窗口就停止迭代。
EnumThreadWndMain = ENUM_STOP
End Function
' MainApp 在它的 Terminate 事件中调用这个子程序;
' 否则隐藏窗体将使
' 应用程序免于被关闭。
Public Sub FreeProcessWindow()
Unload mfrmProcess
Set mfrmProcess = Nothing
End Sub
注意 这种以来标识第一个线程的技术在 Visual Basic 将来的版本中可能会有问题。
可以看到 Sub Main 在第一次以后对于任何线程都不再有任何动作。在增加创建 MultiUse 对象的代码(以便启动后继的线程)时,应该确保包含了初始化这些对象的代码。
EnumThreadWindows 和回调函数 EnumThreadWndMain 一起使用,以便能确定 Visual Basic 为其内部使用而创建的一个隐藏窗口的位置。这个隐藏窗口的窗口句柄被传递给 GetWindowThreadProcessId,该函数返回进程标识符。进程标识符将被用来创建由 Sub Main 加载的隐藏窗口 (frmProcess) 的唯一标题。后继线程检测到这个窗口后就能知道它们不需要再创建 MainApp 对象了。这种转换是必需的,因为 Visual Basic 没有提供识别应用程序主线程的方法。
MainApp class 在其 Initialize 事件中显示测试应用程序的主窗体。MainApp 应该把它的 Me 引用传递给主窗体,这样该窗体就能保证 MainApp 不被终止。从主用户界面可以创建所有的后继线程。将 MainApp 的 Instancing 属性设成 PublicNotCreatable 能有助于避免显示两个用户主界面的窗体。
下面是 MainApp 类和它的相关窗体(上面步骤5和6)的简单的示例:
' MainApp 类的代码。
Private mfrmMTMain As New frmMTMain
Private Sub Class_Initialize()
Set mfrmMTMain.MainApp = Me
mfrmMTMain.Caption = mfrmMTMain.Caption & " (" & App.ThreadID & ")"
mfrmMTMain.Show
End Sub
Friend Sub Closing()
Set mfrmMTMain = Nothing
End Sub
Private Sub Class_Terminate()
' 清理隐藏窗口。
Call FreeProcessWindow
End Sub
' frmMTMain 窗体的代码。
Public MainApp As MainApp
Private Sub Form_Unload(Cancel As Integer)
Call MainApp.Closing
Set MainApp = Nothing
End Sub
' 一个 MultiUse 的 ThreadedWindow 类的代码。
Private mMainApp As MainApp
Private mfrm As New frmThreadedWindow
Public Sub Initialize(ByVal ma As MainApp)
Set mMainApp = ma
Set mfrm.ThreadedWindow = Me
mfrm.Caption = mfrm.Caption & " (" & App.ThreadID & ")"
mfrm.Show
End Sub
Friend Sub Closing()
Set mfrm = Nothing
End Sub
' frmThreadedWindow 窗体的代码。
Public ThreadedWindow As ThreadedWindow
Private Sub Form_Unload(Cancel As Integer)
Call ThreadedWindow.Closing
Set ThreadedWindow = Nothing
End Sub
下面的代码段显示了如何初始化 ThreadedWindow 对象:
'测试应用程序的主窗体( frmMTMain )代码。
Private Sub mnuFileNewTW_Click()
Dim tw As ThreadedWindow
Set tw = CreateObject("ThreadDemo.ThreadedWindow")
' 告诉新对象显示它的窗体,并
' 将一个对主应用程序
' 对象的引用传递给它。
Call tw.Initialize(Me.MainApp)
End Sub
'测试应用程序中不需要这些代码
Private Sub mnuFileNewObject_Click(Index As Integer)
Dim iapt As IApartment
Select Case Index
Case otThreadedWindow
Set iapt = CreateObject("ThreadDemo.ThreadedWindow")
' (其它情况……)
End Select
' 初始化对象的公用代码。
Call iapt.Initialize(MainApp)
End Sub
CreateThread的声明:
Private Declare Function CreateThread Lib "kernel32" Alias "CreateThread" (lpThreadAttributes As SECURITY_ATTRIBUTES, ByVal dwStackSize As Long, lpStartAddress As Long, lpParameter As Any, ByVal dwCreationFlags As Long, lpThreadId As Long) As Long