使用Visual Basic 6實現真正實用的多執行緒

visual|多線程  

事實上使用Visual Basic的ActiveX exe技術可以輕鬆的實現多執行緒.

原理先不說了,先舉個樣本,有興趣的話大家可以一起討論

1.建立一個工程,類型選擇ActiveX Exe,工程重新命名為TestExe
在工程中添加一個Form,放上一個Timer控制項.
將Class1改名為clsTest,注意其Instancing要設定為5-MultiUse, 以下是其代碼:

Option Explicit
Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Private WithEvents oTimer As Timer
Private frmTmp As Form1
Private lTotalLoop As Long
Private bDoStop As Boolean
Private lInterval As Long

Public Event Progress(ByVal lProgress As Long)

Public Sub StartSub(ByVal lTotal As Long)
    lTotalLoop = lTotal
    oTimer.Enabled = True
End Sub

Public Sub StopSub()
    bDoStop = True
End Sub

Private Sub Class_Initialize()
    Set frmTmp = New Form1
    Load frmTmp
    Set oTimer = frmTmp.Timer1
    oTimer.Enabled = False
    bDoStop = False
    lInterval = 1
End Sub

Private Sub DoLoop()
    Dim i As Long
    For i = 0 To lTotalLoop
        Sleep (lInterval)
        RaiseEvent Progress(i)
       
        If bDoStop = True Then
            Exit Sub
        End If
       
    Next
End Sub

Private Sub Class_Terminate()
    Unload frmTmp
    Set frmTmp = Nothing
    Set oTimer = Nothing
End Sub

Private Sub oTimer_Timer()
    oTimer.Enabled = False
    DoLoop
End Sub

Public Property Get lMillisecs() As Long
    lMillisecs = lInterval
End Property

Public Property Let lMillisecs(ByVal vNewValue As Long)
    lInterval = vNewValue
End Property

在TestExe Property(工程屬性)的Threading Model中,設定Thread per Object,或者選擇Thread pool中設定大於1的數值.如把Thread pool設定為2, 則調用此ActiveX Exe最多能同時有兩個線程, 更多的請求將放置於隊列中.
編譯TestExe

下面來測試我們的多線程程式:

建立一個Standard Exe工程,在Reference中選擇剛剛做好的TestExe.exe
在Form1中添加兩個ListBox,兩個CommandButton,Command1為開始,Command2為停止
以下是Project1.Form1的代碼:

Option Explicit
Private WithEvents oTest1 As TestEXE.clsTest
Private WithEvents oTest2 As TestEXE.clsTest

Private Sub Command1_Click()
    Set oTest1 = New TestEXE.clsTest
    oTest1.lMillisecs = 100
    oTest1.StartSub (1000)
   
    Set oTest2 = New TestEXE.clsTest
    oTest2.lMillisecs = 100
    oTest2.StartSub (1000)
End Sub

Private Sub Command2_Click()
    oTest1.StopSub
    oTest2.StopSub
End Sub

Private Sub Form_Unload(Cancel As Integer)
    Set oTest1 = Nothing
    Set oTest2 = Nothing
End Sub

Private Sub oTest1_Progress(ByVal lProgress As Long)
    List1.AddItem lProgress
    List1.ListIndex = List1.ListCount - 1
End Sub

Private Sub oTest2_Progress(ByVal lProgress As Long)
    List2.AddItem lProgress
    List2.ListIndex = List2.ListCount - 1
End Sub

啟動Project1,點擊Command1,怎麼樣,看見來效果了嗎? 試著把TestExe的Thread pool改成1看看會怎麼樣? 這是我認為最簡單且穩固的多線程實現方法了,大家有什麼好的想法歡迎留言.