用VisualBasic創建多線程應用程序
問題背景：
有時候我們做程序時有這樣的需求：有一個需要運行時間很長的循環，那么程序只有等待循環運行結束后才執行別的程序代碼，這樣機器一直處于循環之中，而不能響應別的事情，對CPU資源來說是一種浪費，那么可不可以既讓循環執行，又可以執行程序另外的一部分代碼呢？答案是可以的，那就要用到多線程了。
相關知識：
進程：是指程序在一個數據集合上運行的過程，是操作系統進行資源分配和調度運行的一個獨立單位，簡單來說進程就是程序的一次執行。
進程的兩個基本屬性：
1.進程是一個可擁有資源的獨立單位；
2. 進程同時又是一個可以獨立調度和分配的基本單位。
操作系統中引入進程的目的是為了使多個程序并發執行，以改善資源利用率及提高系統的吞吐量。
線程：線是進程中的一個實體，是被系統獨立調度和分配的基本單位。線程自己基本上不擁有系統資源，只擁有一些在運行中必不可少的資源，但它可與同屬一個進程的其他線程共享進程所擁有的全部資源。同一個進程中的多個線程之間可以并發執行。
問題實現：
VB可不可以創建多線程呢？答案：VB本身不可以，但用API函數VB可以實現。
在VB中創建線程用到以下幾個API函數：
了解完上面的API函數后請看下面的實例：
實例效果：此實例實現三個圖片框的背景色一起變色。
實例的窗體布局見圖：
程序的工程窗口：
源代碼如下
窗體中的代碼：
總結：
本程序的缺點是程序運行時CPU占用率高。
至此全部源代碼結束，在實例的基礎上可以根據個人需要做出不同的多線程應用程序，可以用此類模塊創建ActiveX DLL，然后引用這個DLL來進行調用。
有時候我們做程序時有這樣的需求：有一個需要運行時間很長的循環，那么程序只有等待循環運行結束后才執行別的程序代碼，這樣機器一直處于循環之中，而不能響應別的事情，對CPU資源來說是一種浪費，那么可不可以既讓循環執行，又可以執行程序另外的一部分代碼呢？答案是可以的，那就要用到多線程了。
相關知識：
進程：是指程序在一個數據集合上運行的過程，是操作系統進行資源分配和調度運行的一個獨立單位，簡單來說進程就是程序的一次執行。
進程的兩個基本屬性：
1.進程是一個可擁有資源的獨立單位；
2. 進程同時又是一個可以獨立調度和分配的基本單位。
操作系統中引入進程的目的是為了使多個程序并發執行，以改善資源利用率及提高系統的吞吐量。
線程：線是進程中的一個實體，是被系統獨立調度和分配的基本單位。線程自己基本上不擁有系統資源，只擁有一些在運行中必不可少的資源，但它可與同屬一個進程的其他線程共享進程所擁有的全部資源。同一個進程中的多個線程之間可以并發執行。
問題實現：
VB可不可以創建多線程呢？答案：VB本身不可以，但用API函數VB可以實現。
在VB中創建線程用到以下幾個API函數：
| '創建線程API '此API經過改造，lpThreadAttributes改為Any型，lpStartAddress改為傳值引用： '因為函數入口地址是由形參變量傳遞，如果用傳址那將傳遞形參變量的地址而不是函數的入口地址 ' 參數dwStackSize為應用程序堆棧大小，lpStartAddress為函數入口地址 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 '終止線程API Private Declare Function TerminateThread Lib "kernel32" (ByVal hThread As Long, ByVal dwExitCode As Long) As Long '激活線程API,參數hThread為CreateThread創建的線程句柄 Private Declare Function ResumeThread Lib "kernel32" (ByVal hThread As Long) As Long '掛起線程API Private Declare Function SuspendThread Lib "kernel32" (ByVal hThread As Long) As Long |
了解完上面的API函數后請看下面的實例：
實例效果：此實例實現三個圖片框的背景色一起變色。
實例的窗體布局見圖：
 |
程序的工程窗口：
 |
源代碼如下
窗體中的代碼：
| Option Explicit '開始 Private Sub Command1_Click() On Error Resume Next With myThreadleft .Initialize AddressOf Fillleft '傳遞過程地址給線程 .ThreadEnabled = True End With With myThreadright .Initialize AddressOf Fillright .ThreadEnabled = True End With With myThreadbottom .Initialize AddressOf Fillbottom .ThreadEnabled = True End With MsgBox "多線程正在運行...，看看圖片框控件的變色效果！", 64, "信息" '終止線程運行 Set myThreadleft = Nothing Set myThreadright = Nothing Set myThreadbottom = Nothing End Sub '結束 Private Sub Command2_Click() Unload Me End Sub 模塊中的代碼： Option Explicit '時間計數API Private Declare Function GetTickCount Lib "kernel32" () As Long '聲明cls_thread類的對象變量 Public myThreadleft As New cls_thread, myThreadright As New cls_thread, myThreadbottom As New cls_thread Sub Main() Load Form1 Form1.Show End Sub Public Sub Fillleft() Static Bkgcolor As Long Dim LongTick As Long, Longcounter As Long On Error Resume Next For Longcounter = 0 To 3000 DoEvents Bkgcolor = Longcounter Mod 256 Form1.Picture1.BackColor = RGB(Bkgcolor, 0, 0) LongTick = GetTickCount While GetTickCount - LongTick < 10 '延時10毫秒,下同 Wend Next Set myThreadleft = Nothing '如果循環結束則終止當前線程運行，下同 End Sub Public Sub Fillright() Static Bkgcolor As Long Dim LongTickValue As Long, Longcounter As Long On Error Resume Next For Longcounter = 0 To 3000 DoEvents Bkgcolor = Longcounter Mod 256 Form1.Picture2.BackColor = RGB(0, Bkgcolor, 0) LongTickValue = GetTickCount While GetTickCount - LongTickValue < 10 Wend Next Set myThreadright = Nothing End Sub Public Sub Fillbottom() Static Bkgcolor As Long Dim LongTick As Long, Longcounter As Long On Error Resume Next For Longcounter = 0 To 3000 DoEvents Bkgcolor = Longcounter Mod 256 Form1.Picture3.BackColor = RGB(0, 0, Bkgcolor) LongTick = GetTickCount While GetTickCount - LongTick < 10 Wend Next Set myThreadright = Nothing End Sub 類模塊中的代碼： '功能：創建多線程類，用于初始化線程。 類名：cls_Thread '參數：LongPointFunction 用于接收主調過程傳遞過來的函數地址值 '調用方法：1.聲明線程類對象變量 Dim mythread as cls_Thread ' 2.調用形式：With mythread ' .Initialize AddressOf 自定義過程或函數名 '(初始化線程) . ' .ThreadEnabled = True '(設置線程是否激活) ' End With ' 3.終止調用： Set mythread = Nothing ' Crate By : 陳宇 On 2004.5.10 Copyright(C).Ldt By CY-soft 2001--2004 ' Email:[email protected] ' Test On： VB6.0+Win98 AND VB6.0+WinXP It's Pass ！ Option Explicit '創建線程API '此API經過改造，lpThreadAttributes改為Any型，lpStartAddress改為傳值引用： '因為函數的入口地址由形參變量傳遞，如果用傳址那將傳遞形參變量的地址而不是函數的入口地址 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 '終止線程API Private Declare Function TerminateThread Lib "kernel32" (ByVal hThread As Long, ByVal dwExitCode As Long) As Long '激活線程API Private Declare Function ResumeThread Lib "kernel32" (ByVal hThread As Long) As Long '掛起線程API Private Declare Function SuspendThread Lib "kernel32" (ByVal hThread As Long) As Long Private Const CREATE_SUSPENDED = &H4 '線程掛起常量 '自定義線程結構類型 Private Type udtThread Handle As Long Enabled As Boolean End Type Private meTheard As udtThread '初始化線程 Public Sub Initialize(ByVal LongPointFunction As Long) Dim LongStackSize As Long, LongCreationFlags As Long, LpthreadId As Long, LongNull As Long On Error Resume Next LongNull = 0 LongStackSize = 0 LongCreationFlags = CREATE_SUSPENDED '創建線程后先掛起，由程序激活線程 '創建線程并返線程句柄 meTheard.Handle = CreateThread(LongNull, LongStackSize, ByVal LongPointFunction, LongNull, LongCreationFlags, LpthreadId) If meTheard.Handle = LongNull Then MsgBox "線程創建失敗！", 48, "錯誤" End If End Sub '獲取線程是否激活屬性 Public Property Get ThreadEnabled() As Boolean On Error Resume Next Enabled = meTheard.Enabled End Property '設置線程是否激活屬性 Public Property Let ThreadEnabled(ByVal Newvalue As Boolean) On Error Resume Next '若激活線程（Newvalue為真）設為TRUE且此線程原來沒有激活時激活此線程 If Newvalue And (Not meTheard.Enabled) Then ResumeThread meTheard.Handle meTheard.Enabled = True Else '若激活線程（Newvalue為真）且此線程原來已激活則掛起此線程 If meTheard.Enabled Then SuspendThread meTheard.Handle meTheard.Enabled = False End If End If End Property '終止線程事件 Private Sub Class_Terminate() On Error Resume Next Call TerminateThread(meTheard.Handle, 0) End Sub |
總結：
本程序的缺點是程序運行時CPU占用率高。
至此全部源代碼結束，在實例的基礎上可以根據個人需要做出不同的多線程應用程序，可以用此類模塊創建ActiveX DLL，然后引用這個DLL來進行調用。