问题1:因为VB的只能是单执行绪~所以
理论上此题无解~除非调用API解决~
刚好这里有个类范例可以解决问题~
看不懂不要问我~因为我也看不懂
module:
程序代码:
Option Explicit
'Public Const THREAD_PRIORITY_ERROR_RETURN = (MAXLONG)
Public Const THREAD_BASE_PRIORITY_MAX = 2
Public Const THREAD_BASE_PRIORITY_MIN = -2
Public Const THREAD_BASE_PRIORITY_LOWRT = 15
Public Const THREAD_BASE_PRIORITY_IDLE = -15
Public Const THREAD_PRIORITY_HIGHEST = THREAD_BASE_PRIORITY_MAX
Public Const THREAD_PRIORITY_IDLE = THREAD_BASE_PRIORITY_IDLE
Public Const THREAD_PRIORITY_LOWEST = THREAD_BASE_PRIORITY_MIN
Public Const THREAD_PRIORITY_NORMAL = 0
Public Const THREAD_PRIORITY_TIME_CRITICAL = THREAD_BASE_PRIORITY_LOWRT
Public Const THREAD_PRIORITY_ABOVE_NORMAL = (THREAD_PRIORITY_HIGHEST - 1)
Public Const THREAD_PRIORITY_BELOW_NORMAL = (THREAD_PRIORITY_LOWEST + 1)
Public Const CREATE_SUSPENDED = &H4
'declares
Public 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
Public Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Public Declare Function TerminateThread Lib "kernel32" (ByVal hThread As Long, ByVal dwExitCode As Long) As Long
Public Declare Function TerminateProcess Lib "kernel32" (ByVal hProcess As Long, ByVal uExitCode As Long) As Long
Public Declare Function GetCurrentProcess Lib "kernel32" () As Long
Public Declare Function WaitForSingleObject Lib "kernel32.dll" (ByVal hHandle As Long, ByVal dwMilliseconds As Long) As Long
Public Declare Function CreateEvent& Lib "kernel32" Alias "CreateEventA" (ByVal lpEventAttributes As Long, ByVal bManualReset As Long, ByVal bInitialState As Long, ByVal lpname As String)
Public Declare Function SuspendThread Lib "kernel32" (ByVal hThread As Long) As Long
Public Declare Function ResumeThread Lib "kernel32" (ByVal hThread As Long) As Long
Public Declare Function SetThreadPriority Lib "kernel32" (ByVal hThread As Long, ByVal nPriority As Long) As Long
Public Declare Function ShellAbout Lib "shell32.dll" Alias "ShellAboutA" (ByVal hwnd As Long, ByVal szApp As String, ByVal szOtherStuff As String, ByVal hIcon As Long) As Long
Public Declare Function GetDesktopWindow Lib "user32" () As Long
Class:
程序代码:
Option Explicit
Dim m_threadhandle As Long
Public m_thread_created As Boolean
Enum threadpriority
th_normal = THREAD_PRIORITY_NORMAL
th_abovenormal = THREAD_PRIORITY_ABOVE_NORMAL
th_belownormal = THREAD_PRIORITY_BELOW_NORMAL
th_idle = THREAD_PRIORITY_IDLE
th_lowest = THREAD_PRIORITY_LOWEST
th_critical = THREAD_PRIORITY_TIME_CRITICAL
th_highest = THREAD_PRIORITY_HIGHEST
End Enum
Public Sub startthread(v_addressoffunction As Long, Optional v_immediately As Boolean = True, Optional v_setpriority As threadpriority = threadpriority.th_normal)
Attribute startthread.VB_Description = "This function takes the address of the function that is to be executed in a seperate thread use address of operator in vb make sure the function does have doevents statement in the loop"
Dim l_tid As Long
If Not m_thread_created Then
If v_addressoffunction > 0 Then
'm_thread_created = True
If v_immediately Then
m_threadhandle = CreateThread(ByVal 0&, ByVal 0&, v_addressoffunction, ByVal 0&, 0&, l_tid)
Else
'use resume thread for execution
m_threadhandle = CreateThread(ByVal 0&, ByVal 0&, v_addressoffunction, ByVal 0&, CREATE_SUSPENDED, l_tid)
End If
If m_threadhandle > 0 Then
Call setpriority(v_setpriority)
m_thread_created = True
End If
End If
End If
End Sub
Public Sub stopthread()
Dim l_ret As Long
If m_thread_created Then
l_ret = TerminateThread(m_threadhandle, 0&)
m_thread_created = False
End If
End Sub
Public Sub pausethread()
Dim l_ret As Long
If m_thread_created Then
l_ret = SuspendThread(m_threadhandle)
End If
End Sub
Public Sub ResumetheThread()
Dim l_ret As Long
If m_thread_created Then
l_ret = ResumeThread(m_threadhandle)
End If
End Sub
Public Sub setpriority(Optional ByVal v_priority As threadpriority = threadpriority.th_normal)
Dim l_ret As Long
If m_thread_created Then
l_ret = SetThreadPriority(m_threadhandle, v_priority)
End If
End Sub
Private Sub Class_Initialize()
m_thread_created = False
End Sub
Private Sub Class_Terminate()
Dim l_ret As Long
If m_threadhandle > 0 Then
l_ret = TerminateThread(m_threadhandle, 0&)
End If
End Sub
Public Sub setotherthreadpriority(ByVal v_threadid As Long, Optional ByVal v_priority As threadpriority = threadpriority.th_normal)
Dim l_ret As Long
l_ret = SetThreadPriority(v_threadid, v_priority)
End Sub
Public Sub about()
Attribute about.VB_Description = "shows about"
Attribute about.VB_UserMemId = -552
ShellAbout GetDesktopWindow(), "Multi threader dll", "Multi threader", 0&
End Sub
[
本帖最后由 wube 于 2011-5-25 22:39 编辑 ]