|
|
发表于 2006-4-5 10:36:00
|
显示全部楼层
Re:向大家请教一个类模块编程设计的问题
宣三国程序中的一个类
'子弹集合类(clsShots)
'------------------------------------------------------------------------------------------------------------------------------
Option Explicit
Private Const mShotMax As Long = 10000
Private mShots(1 To mShotMax) As clsShot
Private mFreeList(1 To mShotMax) As Long
Private mFreeHeader As Long
Private mCount As Long
Private Sub Remove(ByVal i As Long)
Debug.Assert ObjPtr(mShots(i)) > 0
' Debug.Assert mShots(i).Terminating = False
mShots(i).Done
Set mShots(i) = Nothing
Debug.Assert ObjPtr(mShots(i)) = 0
mFreeList(i) = mFreeHeader
mFreeHeader = i
mCount = mCount - 1
End Sub
Public Function Add(ByVal sType As String, _
ByVal nPositionX As Long, _
ByVal nPositionY As Long, _
ByVal nTargetX As Long, _
ByVal nTargetY As Long, _
ByVal InitV As Single, _
ByVal Acc As Single, _
ByVal Ztop As Single, _
Optional ByVal IsEffect As Boolean = False, _
Optional ByVal Power As Long = 0, _
Optional ByVal HotSprCount As Long = -1, _
Optional ByVal ParentSpr_ID As Long = -1, _
Optional ByVal ObjSpr_ID As Long = -1, _
Optional ByVal IsFrameLoop As Boolean = False, _
Optional ByRef useobj As GamUserObj = Nothing, _
Optional ByVal ShotType As Long, _
Optional ByVal AlaphaVal As Integer = 0, _
Optional ByVal AlaphaValEnd As Long = 0, _
Optional ByVal IsFollowSpr As Boolean = False) As clsShot
Dim i As Long
Dim WAVEVOLUME As Integer
If mFreeHeader > 0 Then
i = mFreeHeader
mFreeHeader = mFreeList(mFreeHeader)
Else ' 无空间可分配
Exit Function
End If
Debug.Assert ObjPtr(mShots(i)) = 0
Set mShots(i) = New clsShot
mCount = mCount + 1
With mShots(i)
.ID = i
Set .useobj = useobj
.ParentSpr_ID = ParentSpr_ID
.ObjSpr_ID = ObjSpr_ID
.Power = Power
.IsEffect = IsEffect Or (ParentSpr_ID = -1)
.HotSprCount = HotSprCount
.AlaphaVal = AlaphaVal
.ShotType = ShotType
'---------------------------
'以下并非重复,跟踪有用
'---------------------------
.InitV = InitV
.Acc = Acc
.Ztop = Ztop
.Frame_Time = GetTickCount
.nTargetX = nTargetX
.nTargetY = nTargetY
.PositionX = nPositionX
.PositionY = nPositionY
.ln.Init nPositionX, nPositionY, nTargetX, nTargetY, InitV, Acc, Ztop
.SetSurfaceName sType
.ln_MaxStep = .ln.MaxStep
' Debug.Assert .ln_MaxStep > 0
End With
If SoundPresent Then
'------------------------------------
'这里是以玩家为听众,离玩家越远声音越小
'------------------------------------
WAVEVOLUME = 150 - (Abs(User_Me.Map_X - nPositionX) + Abs(User_Me.Map_Y - nPositionY)) * 100 \ ScreenX
If IsEffect = False Then
If useobj.ShotType = 3 Then
'闪电
WAVEVOLUME = 300 - (Abs(User_Me.Map_X - nPositionX) + Abs(User_Me.Map_Y - nPositionY)) * 100 \ ScreenX
End If
End If
If WAVEVOLUME > 0 Then
Sounds.Add sType, WAVEVOLUME
End If
End If
Set Add = mShots(i)
End Function
Public Property Get Item(i As Long) As clsShot
Set Item = mShots(i)
End Property
Public Property Get Count() As Long
Count = mCount
End Property
Public Sub Update() '数据更新
Dim i As Long
Dim Shot As clsShot
For i = 1 To mShotMax
Set Shot = mShots(i)
If ObjPtr(Shot) > 0 Then
If Shot.Terminating Then
Remove i
Else
Shot.Update
End If
End If
Next
End Sub
Public Sub Render() '显示
Dim i As Long
Dim Shot As clsShot
For i = 1 To mShotMax
Set Shot = mShots(i)
If ObjPtr(Shot) > 0 Then
If Shot.Terminating Then
Remove i
Else
Shot.Render
End If
End If
Next
End Sub
Public Sub Clear() '类初始化
Dim i As Long
For i = 1 To mShotMax
If ObjPtr(mShots(i)) > 0 Then
If mShots(i).Terminating = False Then
mShots(i).Done
End If
Set mShots(i) = Nothing
Debug.Assert ObjPtr(mShots(i)) = 0
End If
Next
For i = 1 To mShotMax - 1
mFreeList(i) = i + 1
Next i
mFreeList(mShotMax) = 0
mFreeHeader = 1
mCount = 0
End Sub
Private Sub Class_Initialize()
Dim i As Long
For i = 1 To mShotMax - 1
mFreeList(i) = i + 1
Next i
mFreeList(mShotMax) = 0
mFreeHeader = 1
mCount = 0
End Sub
Private Sub Class_Terminate()
Clear
End Sub
'------------------------------------------------------------------------------------------------------------------------------
'子弹类(clsShot)
Private ID As Long '在数组中的位置
|
|
楼主