clsthreading.cls

一款飞机射击游戏的源代码

VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
  Persistable = 0  'NotPersistable
  DataBindingBehavior = 0  'vbNone
  DataSourceBehavior  = 0  'vbNone
  MTSTransactionMode  = 0  'NotAnMTSObject
END
Attribute VB_Name = "clsThreading"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
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 TerminateThread Lib "kernel32" (ByVal hThread As Long, ByVal dwExitCode 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 ResumeThread Lib "kernel32" (ByVal hThread As Long) As Long
Private Declare Function SuspendThread Lib "kernel32" (ByVal hThread As Long) As Long
Private Declare Function GetCurrentThread Lib "kernel32" () As Long
Private Declare Function GetCurrentThreadId Lib "kernel32" () As Long

Private Const MAXLONG = &H7FFFFFFF

Private Const THREAD_BASE_PRIORITY_IDLE = -15
Private Const THREAD_BASE_PRIORITY_LOWRT = 15
Private Const THREAD_BASE_PRIORITY_MAX = 2
Private Const THREAD_BASE_PRIORITY_MIN = -2
Private Const THREAD_PRIORITY_HIGHEST = THREAD_BASE_PRIORITY_MAX
Private Const THREAD_PRIORITY_LOWEST = THREAD_BASE_PRIORITY_MIN
Private Const THREAD_PRIORITY_ABOVE_NORMAL = (THREAD_PRIORITY_HIGHEST - 1)
Private Const THREAD_PRIORITY_BELOW_NORMAL = (THREAD_PRIORITY_LOWEST + 1)
Private Const THREAD_PRIORITY_ERROR_RETURN = (MAXLONG)
Private Const THREAD_PRIORITY_IDLE = THREAD_BASE_PRIORITY_IDLE
Private Const THREAD_PRIORITY_NORMAL = 0
Private Const THREAD_PRIORITY_TIME_CRITICAL = THREAD_BASE_PRIORITY_LOWRT

Private Const CREATE_ALWAYS = 2
Private Const CREATE_NEW = 1
Private Const CREATE_NEW_CONSOLE = &H10
Private Const CREATE_NEW_PROCESS_GROUP = &H200
Private Const CREATE_NO_WINDOW = &H8000000
Private Const CREATE_PROCESS_DEBUG_EVENT = 3
Private Const CREATE_SUSPENDED = &H4
Private Const CREATE_THREAD_DEBUG_EVENT = 2

'Types and Enums
Public Enum ThreadPriority
    tpLowest = THREAD_PRIORITY_LOWEST
    tpBelowNormal = THREAD_PRIORITY_BELOW_NORMAL
    tpNormal = THREAD_PRIORITY_NORMAL
    tpAboveNormal = THREAD_PRIORITY_ABOVE_NORMAL
    tpHighest = THREAD_PRIORITY_HIGHEST
End Enum

Private mThreadHandle As Long
Private mThreadID As Long
Private mPriority As Long
Private mEnabled As Boolean
Private mCreated As Boolean

Public Function CreateNewThread(ByVal cFunction As Long, Optional ByVal cPriority As Long = tpNormal, Optional ByVal cEnabled As Boolean = True)
    Dim mHandle As Long
    Dim CreationFlags As Long
    Dim lpThreadID As Long
    
    If mCreated = True Then Exit Function
    
    If cEnabled = True Then
        CreationFlags = 0
    Else
        CreationFlags = CREATE_SUSPENDED
    End If
    mHandle = CreateThread(ByVal 0&, ByVal 0&, cFunction, ByVal 0&, CreationFlags, lpThreadID)
    
    If mHandle = 0 Then 'Failed creating the thread
    Else
        mThreadHandle = mHandle
        mThreadID = lpThreadID
        mCreated = True
    End If
End Function

Public Function TerminateCurrentThread()
    
    On Error Resume Next
    Call TerminateThread(mThreadHandle, ByVal 0&)
    mCreated = False
End Function

Public Property Get ThreadHandle() As Long
    ThreadHandle = mThreadHandle
End Property

Public Property Get ThreadID() As Long
    ThreadID = mThreadID
End Property

Public Property Get Priority() As Long
    On Error Resume Next
    Priority = GetThreadPriority(mThreadHandle)
End Property

Public Property Let Priority(ByVal tmpValue As Long)
    mPriority = tmpValue
    Call SetThreadPriority(mThreadHandle, tmpValue)
End Property

Public Property Get Enabled() As Boolean
    Enabled = mEnabled
End Property

Public Property Let Enabled(ByVal tmpValue As Boolean)
    
    On Error Resume Next
    If tmpValue = True Then
        Call ResumeThread(mThreadHandle)
    ElseIf tmpValue = False Then
        Call SuspendThread(mThreadHandle)
    End If
End Property

Private Sub Class_Terminate()
    Call TerminateCurrentThread
End Sub