如何让一个模块在运行过程中中止运行.

[bluecc]

程序在调用一个模块时,由于其运行时间很长,有时用户不需要等到其完全运行结束就要使用其他功能,能不能让这个模块运行到一半就退出.

[lxqlogo0]

在模块中多处添加判断语句，如
if 按钮单击 then exit sub

[nik_Amis]

Timer

DoEvents

[muniu]

退出用exit sub

[fq1]

用多线程去运行那个函数

[marrytone]

如果是循环的话加入doevents,然后用户点击按钮的时候exit function就行了

[bluecc]

问题是函数里不只一个循环,这样的话,到处都要加DOEVENTS及EXIT FUNCTION,很麻烦,有没有好一点的方法
TO FQ1,怎么用多线程.能不能说得详细点

[fq1]

'加入一个类模块名为clsThreads.cls,添加以下代码
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 SetThreadPriority Lib "kernel32" (ByVal hThread As Long, ByVal nPriority As Long) As Long
Private Declare Function GetThreadPriority Lib "kernel32" (ByVal hThread As Long) As Long
Private Declare Function TerminateThread Lib "kernel32" (ByVal hThread As Long, ByVal dwExitCode As Long) As Long
Private Declare Function GetExitCodeThread Lib "kernel32" (ByVal hThread As Long, lpExitCode As Long) As Long
Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long
Private Declare Function GetCurrentThread Lib "kernel32" () As Long
Private Declare Function GetCurrentThreadId Lib "kernel32" () As Long

Const THREAD_BASE_PRIORITY_IDLE = -15
Const THREAD_PRIORITY_HIGHEST = 2
Const THREAD_PRIORITY_IDLE = -15
Const THREAD_PRIORITY_LOWEST = -2
Const THREAD_PRIORITY_ABOVE_NORMAL = (2 - 1)
Const THREAD_PRIORITY_BELOW_NORMAL = (-2 + 1)


Private Thread As Long
Private ThreadStatus As Boolean

Public Sub Initialize(lpfnBasFunc As Long)
Dim dwStackSize As Long
Dim dwCreationFlags As Long
Dim lpThreadId As Long
Dim lpParameter As Long
Dim myNull As Long
myNull = 0& 'create a null pointer
dwStackSize = 0 '0表示用exe stack size
dwCreationFlags = 4 '用4表示初始化后先不激活,让别人来激活
Thread = CreateThread(myNull, dwStackSize, lpfnBasFunc, myNull, dwCreationFlags, lpThreadId)

If Thread = myNull Then
MsgBox "create thread failed"
Else
Debug.Print Thread
Debug.Print GetCurrentThread
Debug.Print GetThreadPriority(Thread)
Debug.Print GetThreadPriority(GetCurrentThread)
Debug.Print SetThreadPriority(GetCurrentThread, 15&)
End If

End Sub

Public Property Let Enabled(ByVal vNewValue As Boolean)
If vNewValue = True And ThreadStatus = False Then

ResumeThread Thread
ThreadStatus = True

ElseIf ThreadStatus = True Then

SuspendThread Thread
ThreadStatus = False

End If
End Property

Public Sub Terminate()
On Error Resume Next
Dim exitcode As Long
Dim ret As Long

ret = GetExitCodeThread(Thread, exitcode)
Debug.Print ret, exitcode, Thread
ret = TerminateThread(Thread, exitcode)
Debug.Print ret
ret = CloseHandle(Thread)
Debug.Print ret
End Sub


'加入一个模块Module1.bas,添加以下代码

Public CR As Boolean

Public Sub RunRunRun()
Form1.Label1.Caption = "没有Doevents的无限循环已经在新开的线程中开始运行了!"
Do While CR
Form1.Label3.Caption = "-"
Form1.Label3.Refresh
Form1.Label3.Caption = "*"
Form1.Label3.Refresh
Loop
End Sub


'form1中需要两个command
Option Explicit

Dim Run3Thread As New clsThreads


Private Sub Command1_Click()
If Command1.Caption = "新开线程" Then
Command1.Caption = "终止线程"
CR = True
Run3Thread.Initialize AddressOf RunRunRun
Run3Thread.Enabled = True
Command2.Enabled = True
Else
CR = False
'Run3Thread.Terminate
Command2.Enabled = False
Command1.Caption = "新开线程"
Set Run3Thread = Nothing
End If
End Sub


Private Sub Command2_Click()
If Command2.Caption = "暂停线程" Then
Command2.Caption = "继续线程"
Run3Thread.Enabled = False
Else
Command2.Caption = "暂停线程"
Run3Thread.Enabled = True
End If
End Sub



Private Sub Form_Load()
Command1.Caption = "新开线程"
Command2.Caption = "暂停线程"
End Sub

Private Sub Form_Unload(Cancel As Integer)
On Error Resume Next

Set Run3Thread = Nothing
End Sub



以上供你参考。
在新线程中运行的函数必须在.bas中
终止线程其实可以不用那个CR变量判断,可直接用Run3Thread.Terminate,只要新线程中运行的函数没有调用它函数自身外的东西就不会有内存泄漏的危险。比如把RunRunRun()中的:
Form1.Label1.Caption = "没有Doevents的无限循环已经在新开的线程中开始运行了!"
Form1.Label3.Caption = "-"
Form1.Label3.Refresh
Form1.Label3.Caption = "*"
Form1.Label3.Refresh
都注释掉就可以

[fq1]

哦!
form1中还需要几个label

[bluecc]

好的,我知道,加分,另外再问一下,同一个函数是否可以在多个线程中开启.

[fq1]

可以没问题,开几个都行!