rabit/r3/Class_Player.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 = "Class_Player"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Option Explicit

' --- public ----------------------------------------------------------------------------------------------

Enum Enum_PlayerControlFlags

    ePCF_Forward = 1
    ePCF_Backward = 2
    ePCF_Left = 4
    ePCF_Right = 8
    ePCF_Break = 16
    ePCF_Horn = 32

End Enum

Enum Enum_PlayerTypes

    ePT_LocalHuman
    ePT_LocalRobot
    ePT_Remote

End Enum

Public bOffroad As Boolean

Public lPlayerControlFlags As Enum_PlayerControlFlags

Public lPlayerID As Long

Public lPlayerType As Enum_PlayerTypes  ' What type is the player (local human, local bot, remote player)

Public lRoundCount As Long

Public lTrackSegment As Long

Public sgAcceleration As Single
Public sgAngleY As Single

Public sgRoundBestTime As Single
Public sgRoundTime As Single

Public sgSpeed As Single
Public sgSpeedRate As Single
Public sgSteeringWheelPosition As Single

Public strName As String
Public strPlayerKey As String

' --- private --------------------------------------------------------------------------------------------

Private prvtpVecPlayerPosition As D3DVECTOR

Private prvCol_DSSoundBuffers As New Collection
Private prvCol_DS3DBuffers As New Collection
'

Public Function AddSoundFromFile(strWaveFilePath As String)

Dim clDSSoundBuffer As DirectSoundSecondaryBuffer8
Dim clDS3DBuffer As DirectSound3DBuffer8

Dim tpSoundBufferDescription As DSBUFFERDESC

Dim tpDSBufferDescription As DSBUFFERDESC

    With tpSoundBufferDescription
    
        .lFlags = DSBCAPS_CTRL3D Or DSBCAPS_LOCSOFTWARE Or DSBCAPS_CTRLVOLUME Or DSBCAPS_CTRLFREQUENCY
        .guid3DAlgorithm = ""
    
    End With
    
    '"App.Path + "\Audio\motor1.wav"
    Set clDSSoundBuffer = clSystem.DS8.CreateSoundBufferFromFile(strWaveFilePath, tpSoundBufferDescription)
    
    clDSSoundBuffer.SetVolume -8192

    Set clDS3DBuffer = clDSSoundBuffer.GetDirectSound3DBuffer

    prvCol_DSSoundBuffers.Add clDSSoundBuffer
    prvCol_DS3DBuffers.Add clDS3DBuffer

End Function

Property Get DS3DBuffer(lIndex As Long) As DirectSound3DBuffer8

    Set DS3DBuffer = prvCol_DS3DBuffers(lIndex)

End Property

Property Get DSSoundBuffer(lIndex As Long) As DirectSoundSecondaryBuffer8

    Set DSSoundBuffer = prvCol_DSSoundBuffers(lIndex)

End Property

Public Function CreatePlayer(lPlayerType As Long, strName As String) As Class_Player

    Set CreatePlayer = New Class_Player
    
    With CreatePlayer

        .lPlayerType = lPlayerType

        .sgAcceleration = 0
        .sgSteeringWheelPosition = 0
        
        .sgAngleY = 0

        .sgSpeed = 0
        .sgSpeedRate = 0
        
        .strName = strName

        .SetPosition clScene.VecPlayerStartPosition
        
        .AddSoundFromFile App.Path + "\Audio\motor1.wav"
        .AddSoundFromFile App.Path + "\Audio\brake1.wav"
        .AddSoundFromFile App.Path + "\Audio\horn1.wav"

    End With

End Function

Public Function GetPosition() As D3DVECTOR

    GetPosition = prvtpVecPlayerPosition

End Function

Public Function SetPosition(tpVecPosition As D3DVECTOR)

Dim l As Long
Dim clDS3DBuffer As DirectSound3DBuffer8

    prvtpVecPlayerPosition = tpVecPosition

    For l = 1 To prvCol_DS3DBuffers.Count
    
        Set clDS3DBuffer = prvCol_DS3DBuffers(l)
        
        clDS3DBuffer.SetPosition tpVecPosition.X, tpVecPosition.Y, tpVecPosition.Z, DS3D_IMMEDIATE

    Next l

End Function

Private Sub Class_Terminate()

Dim clDSSoundBuffer As DirectSoundSecondaryBuffer8

    While prvCol_DSSoundBuffers.Count > 0
    
        Set clDSSoundBuffer = prvCol_DSSoundBuffers(1)
        
        clDSSoundBuffer.Stop

        prvCol_DSSoundBuffers.Remove 1
        prvCol_DS3DBuffers.Remove 1
    
    Wend

End Sub
1	VERSION 1.0 CLASS
2	BEGIN
3	MultiUse = -1 'True
4	Persistable = 0 'NotPersistable
5	DataBindingBehavior = 0 'vbNone
6	DataSourceBehavior = 0 'vbNone
7	MTSTransactionMode = 0 'NotAnMTSObject
8	END
9	Attribute VB_Name = "Class_Player"
10	Attribute VB_GlobalNameSpace = False
11	Attribute VB_Creatable = True
12	Attribute VB_PredeclaredId = False
13	Attribute VB_Exposed = False
14	Option Explicit
15
16	' --- public ----------------------------------------------------------------------------------------------
17
18	Enum Enum_PlayerControlFlags
19
20	ePCF_Forward = 1
21	ePCF_Backward = 2
22	ePCF_Left = 4
23	ePCF_Right = 8
24	ePCF_Break = 16
25	ePCF_Horn = 32
26
27	End Enum
28
29	Enum Enum_PlayerTypes
30
31	ePT_LocalHuman
32	ePT_LocalRobot
33	ePT_Remote
34
35	End Enum
36
37	Public bOffroad As Boolean
38
39	Public lPlayerControlFlags As Enum_PlayerControlFlags
40
41	Public lPlayerID As Long
42
43	Public lPlayerType As Enum_PlayerTypes ' What type is the player (local human, local bot, remote player)
44
45	Public lRoundCount As Long
46
47	Public lTrackSegment As Long
48
49	Public sgAcceleration As Single
50	Public sgAngleY As Single
51
52	Public sgRoundBestTime As Single
53	Public sgRoundTime As Single
54
55	Public sgSpeed As Single
56	Public sgSpeedRate As Single
57	Public sgSteeringWheelPosition As Single
58
59	Public strName As String
60	Public strPlayerKey As String
61
62	' --- private --------------------------------------------------------------------------------------------
63
64	Private prvtpVecPlayerPosition As D3DVECTOR
65
66	Private prvCol_DSSoundBuffers As New Collection
67	Private prvCol_DS3DBuffers As New Collection
68	'
69
70	Public Function AddSoundFromFile(strWaveFilePath As String)
71
72	Dim clDSSoundBuffer As DirectSoundSecondaryBuffer8
73	Dim clDS3DBuffer As DirectSound3DBuffer8
74
75	Dim tpSoundBufferDescription As DSBUFFERDESC
76
77	Dim tpDSBufferDescription As DSBUFFERDESC
78
79	With tpSoundBufferDescription
80
81	.lFlags = DSBCAPS_CTRL3D Or DSBCAPS_LOCSOFTWARE Or DSBCAPS_CTRLVOLUME Or DSBCAPS_CTRLFREQUENCY
82	.guid3DAlgorithm = ""
83
84	End With
85
86	'"App.Path + "\Audio\motor1.wav"
87	Set clDSSoundBuffer = clSystem.DS8.CreateSoundBufferFromFile(strWaveFilePath, tpSoundBufferDescription)
88
89	clDSSoundBuffer.SetVolume -8192
90
91	Set clDS3DBuffer = clDSSoundBuffer.GetDirectSound3DBuffer
92
93	prvCol_DSSoundBuffers.Add clDSSoundBuffer
94	prvCol_DS3DBuffers.Add clDS3DBuffer
95
96	End Function
97
98	Property Get DS3DBuffer(lIndex As Long) As DirectSound3DBuffer8
99
100	Set DS3DBuffer = prvCol_DS3DBuffers(lIndex)
101
102	End Property
103
104	Property Get DSSoundBuffer(lIndex As Long) As DirectSoundSecondaryBuffer8
105
106	Set DSSoundBuffer = prvCol_DSSoundBuffers(lIndex)
107
108	End Property
109
110	Public Function CreatePlayer(lPlayerType As Long, strName As String) As Class_Player
111
112	Set CreatePlayer = New Class_Player
113
114	With CreatePlayer
115
116	.lPlayerType = lPlayerType
117
118	.sgAcceleration = 0
119	.sgSteeringWheelPosition = 0
120
121	.sgAngleY = 0
122
123	.sgSpeed = 0
124	.sgSpeedRate = 0
125
126	.strName = strName
127
128	.SetPosition clScene.VecPlayerStartPosition
129
130	.AddSoundFromFile App.Path + "\Audio\motor1.wav"
131	.AddSoundFromFile App.Path + "\Audio\brake1.wav"
132	.AddSoundFromFile App.Path + "\Audio\horn1.wav"
133
134	End With
135
136	End Function
137
138	Public Function GetPosition() As D3DVECTOR
139
140	GetPosition = prvtpVecPlayerPosition
141
142	End Function
143
144	Public Function SetPosition(tpVecPosition As D3DVECTOR)
145
146	Dim l As Long
147	Dim clDS3DBuffer As DirectSound3DBuffer8
148
149	prvtpVecPlayerPosition = tpVecPosition
150
151	For l = 1 To prvCol_DS3DBuffers.Count
152
153	Set clDS3DBuffer = prvCol_DS3DBuffers(l)
154
155	clDS3DBuffer.SetPosition tpVecPosition.X, tpVecPosition.Y, tpVecPosition.Z, DS3D_IMMEDIATE
156
157	Next l
158
159	End Function
160
161	Private Sub Class_Terminate()
162
163	Dim clDSSoundBuffer As DirectSoundSecondaryBuffer8
164
165	While prvCol_DSSoundBuffers.Count > 0
166
167	Set clDSSoundBuffer = prvCol_DSSoundBuffers(1)
168
169	clDSSoundBuffer.Stop
170
171	prvCol_DSSoundBuffers.Remove 1
172	prvCol_DS3DBuffers.Remove 1
173
174	Wend
175
176	End Sub
MailToCvsAdmin">MailToCvsAdmin	ViewVC Help
Powered by ViewVC 1.1.26