home *** CD-ROM | disk | FTP | other *** search
/ Planet Source Code Jumbo …e CD Visual Basic 1 to 7 / 1_2002.ISO / Data / Zips / UltimaX_(A1392481012002.psc / Collision.bas next >
Encoding:
BASIC Source File  |  2002-02-22  |  7.0 KB  |  224 lines
  1. Attribute VB_Name = "Collision"
  2. Option Explicit
  3.  
  4. 'NOTE: THESE ARE JUST TEST'S......THATS IT..
  5. 'FOR COLLISION DETECTION LOOK IN CLASS MODULES...
  6.  
  7. Private Type CUSTOMVERTEX
  8.  X As Single
  9.  Y As Single
  10.  Z As Single
  11.  tU As Single
  12.  tV As Single
  13. End Type
  14. Private Const D3DFVF_COLORVERTEX = (D3DFVF_XYZ Or D3DFVF_DIFFUSE Or D3DFVF_TEX1)
  15.  
  16. Private Type tCollision
  17.  Sphere1 As D3DVECTOR
  18.  Sphere2 As D3DVECTOR
  19.  Sphere1Radius As Single
  20.  Sphere2Radius As Single
  21.  Distance As Double
  22. End Type
  23. Private Collision As tCollision
  24.  
  25. Private VB1 As Direct3DVertexBuffer8
  26. Private NumVertices1 As Long
  27. Private Vertices1() As CUSTOMVERTEX
  28.  
  29. Private Function GetDist3D(Sphere2 As D3DVECTOR, Sphere1 As D3DVECTOR) As Single
  30.  
  31. 'Note: For realistic and more accurate detection
  32. '      avoid using (^ 2) or the srq() function..
  33.  
  34. 'Big differance..and a lot faster..maybe like 5 - 10 frames faster
  35.  
  36. GetDist3D = (Sphere2.X - Sphere1.X) * (Sphere2.X - Sphere1.X) + (Sphere2.Y - Sphere1.Y) * (Sphere2.Y - Sphere1.Y) + (Sphere2.Z - Sphere1.Z) * (Sphere2.Z - Sphere1.Z)
  37. End Function
  38.  
  39. Public Function CheckSphereCollision(Object1Position As D3DVECTOR, Sphere1Radius As Single, Object2Position As D3DVECTOR, Sphere2Radius As Single, _
  40.                                      Optional CSphereOffsetX As Single = 0, Optional CSphereOffsetY As Single = 0, Optional CSphereOffsetZ As Single = 0) As Boolean
  41. Collision.Sphere1.X = Object1Position.X + CSphereOffsetX
  42. Collision.Sphere1.Y = Object1Position.Y + CSphereOffsetY
  43. Collision.Sphere1.Z = Object1Position.Z + CSphereOffsetZ
  44. Collision.Sphere1Radius = Sphere1Radius
  45.  
  46. Collision.Sphere2.X = Object2Position.X
  47. Collision.Sphere2.Y = Object2Position.Y
  48. Collision.Sphere2.Z = Object2Position.Z
  49. Collision.Sphere2Radius = Sphere2Radius
  50.  
  51. Collision.Distance = GetDist3D(Collision.Sphere1, Collision.Sphere2)
  52.  
  53. If (Sphere1Radius + Sphere2Radius) = Collision.Distance Then
  54.     CheckSphereCollision = True
  55. ElseIf (Sphere1Radius + Sphere2Radius) < Collision.Distance Then
  56.     CheckSphereCollision = False
  57. ElseIf (Sphere1Radius + Sphere2Radius) > Collision.Distance Then
  58.     CheckSphereCollision = True
  59. End If
  60.  
  61. End Function
  62.  
  63. Private Function GetDist3D2(Position2 As D3DVECTOR, Position1 As D3DVECTOR) As Single
  64. GetDist3D2 = (Position2.X - Position1.X) * (Position2.X - Position1.X) + (Position2.Y - Position1.Y) * (Position2.Y - Position1.Y) + (Position2.Z - Position1.Z) * (Position2.Z - Position1.Z)
  65. End Function
  66.  
  67. Public Function CheckCollision(Object As D3DXMesh, Object2Position As D3DVECTOR, Sphere2Radius As Single, _
  68.                                Optional CSphereOffsetX As Single = 0, Optional CSphereOffsetY As Single = 0, Optional CSphereOffsetZ As Single = 0) As Boolean
  69. Dim i As Long
  70. Dim CX As Single
  71. Dim CY As Single
  72. Dim CZ As Single
  73. Dim MX As Single
  74. Dim MY As Single
  75. Dim MZ As Single
  76. Dim X As Single
  77. Dim Y As Single
  78. Dim Z As Single
  79. Dim Center As D3DVECTOR
  80. Dim Radius As Single
  81. Dim Position As D3DVECTOR
  82. Dim mat As D3DMATRIX
  83.  
  84. Set VB1 = Object.GetVertexBuffer
  85. NumVertices1 = Object.GetNumVertices
  86. ReDim Vertices1(NumVertices1)
  87. D3DVertexBuffer8GetData VB1, 0, NumVertices1 * Len(Vertices1(0)), 0, Vertices1(0)
  88.  
  89. D3DD.GetTransform D3DTS_WORLD, mat
  90.  
  91. CX = 0: CY = 0: CZ = 0
  92. For i = 0 To NumVertices1
  93.  X = Vertices1(i).X + CSphereOffsetX
  94.  Y = Vertices1(i).Y + CSphereOffsetY
  95.  Z = Vertices1(i).Z + CSphereOffsetZ
  96.  
  97.  Position.X = X: Position.Y = Y: Position.Z = Z
  98.  
  99.  CX = CX + X * mat.m11 + Y * mat.m21 + Z * mat.m31 + mat.m41
  100.  CY = CY + X * mat.m12 + Y * mat.m22 + Z * mat.m32 + mat.m42
  101.  CZ = CZ + X * mat.m13 + Y * mat.m23 + Z * mat.m33 + mat.m43
  102. Next
  103.  
  104. Center.X = CX / NumVertices1
  105. Center.Y = CY / NumVertices1
  106. Center.Z = CZ / NumVertices1
  107.  
  108. For i = 0 To NumVertices1
  109.  X = Vertices1(i).X
  110.  Y = Vertices1(i).Y
  111.  Z = Vertices1(i).Z
  112.  
  113.  MX = (X * mat.m11 + Y * mat.m21 + Z * mat.m31 + mat.m41) - Center.X
  114.  MY = (X * mat.m11 + Y * mat.m21 + Z * mat.m31 + mat.m41) - Center.Y
  115.  MZ = (X * mat.m11 + Y * mat.m21 + Z * mat.m31 + mat.m41) - Center.Z
  116.  
  117.  Radius = MX * MX + MY * MY + MZ * MZ
  118. Next
  119.  
  120. Collision.Distance = GetDist3D2(Position, Object2Position)
  121.  
  122. If ((Radius + CSphereOffsetX) + Sphere2Radius) = Collision.Distance Then
  123.     CheckCollision = True
  124. ElseIf ((Radius + CSphereOffsetY) + Sphere2Radius) < Collision.Distance Then
  125.     CheckCollision = False
  126. ElseIf ((Radius + CSphereOffsetZ) + Sphere2Radius) > Collision.Distance Then
  127.     CheckCollision = True
  128. End If
  129.  
  130. End Function
  131.  
  132. Public Sub Cleanup_Collision_Engine()
  133. 'Set VB = Nothing
  134. ReDim Vertices(0)
  135. End Sub
  136.  
  137. Public Function Collided(Main_Position As D3DVECTOR, ObjectPos As D3DVECTOR, ByVal ObjectRadius As Single, Optional OffsetX = 0, Optional OffsetZ = 0) As Boolean
  138. If Main_Position.X > (ObjectPos.X + OffsetX) - ObjectRadius _
  139.    And Main_Position.X < (ObjectPos.X + OffsetX) + ObjectRadius _
  140.    And Main_Position.Z > (ObjectPos.Z + OffsetZ) - ObjectRadius _
  141.    And Main_Position.Z < (ObjectPos.Z + OffsetZ) + ObjectRadius Then
  142.  Collided = True
  143. End If
  144. End Function
  145.  
  146. Public Function CheckBoxCollision(Object As D3DXMesh, Object2Position As D3DVECTOR, Sphere2Radius As Single) As Boolean
  147. Dim i As Long
  148. Dim CX As Single
  149. Dim CY As Single
  150. Dim CZ As Single
  151. Dim MX As Single
  152. Dim MY As Single
  153. Dim MZ As Single
  154. Dim X As Single
  155. Dim Y As Single
  156. Dim Z As Single
  157. Dim Center As D3DVECTOR
  158. Dim Radius As Single
  159. Dim Position As D3DVECTOR
  160. Dim mat As D3DMATRIX
  161. Dim Box As D3DBOX
  162.  
  163. Set VB1 = Object.GetVertexBuffer
  164. NumVertices1 = Object.GetNumVertices
  165. ReDim Vertices1(NumVertices1)
  166. D3DVertexBuffer8GetData VB1, 0, NumVertices1 * Len(Vertices1(0)), 0, Vertices1(0)
  167.  
  168. D3DD.GetTransform D3DTS_WORLD, mat
  169.  
  170. CX = 0: CY = 0: CZ = 0
  171. For i = 0 To NumVertices1
  172.  X = Vertices1(i).X
  173.  Y = Vertices1(i).Y
  174.  Z = Vertices1(i).Z
  175.  
  176.  Position.X = X: Position.Y = Y: Position.Z = Z
  177.  
  178.  CX = CX + X * mat.m11 + Y * mat.m21 + Z * mat.m31 + mat.m41
  179.  CY = CY + X * mat.m12 + Y * mat.m22 + Z * mat.m32 + mat.m42
  180.  CZ = CZ + X * mat.m13 + Y * mat.m23 + Z * mat.m33 + mat.m43
  181. Next
  182.  
  183. Center.X = CX / NumVertices1
  184. Center.Y = CY / NumVertices1
  185. Center.Z = CZ / NumVertices1
  186.  
  187. For i = 0 To NumVertices1
  188.  X = Vertices1(i).X
  189.  Y = Vertices1(i).Y
  190.  Z = Vertices1(i).Z
  191.  
  192.  MX = (X * mat.m11 + Y * mat.m21 + Z * mat.m31 + mat.m41) - Center.X
  193.  MY = (X * mat.m11 + Y * mat.m21 + Z * mat.m31 + mat.m41) - Center.Y
  194.  MZ = (X * mat.m11 + Y * mat.m21 + Z * mat.m31 + mat.m41) - Center.Z
  195.  
  196.  Radius = MX * MX + MY * MY + MZ * MZ
  197. Next
  198.  
  199. Box.Left = MX
  200. Box.Right = MX * MX
  201. Box.Top = MY
  202. Box.bottom = MY * MY
  203. Box.front = MZ
  204. Box.back = MZ * MZ
  205.  
  206. If Object2Position.X > Box.Left _
  207.    And Object2Position.X < Box.Right _
  208.    And Object2Position.Z > Box.front _
  209.    And Object2Position.Z < Box.back Then
  210.  CheckBoxCollision = True
  211. End If
  212.  
  213. 'Collision.Distance = GetDist3D2(position, Object2Position)
  214.  
  215. 'If (Radius + Sphere2Radius) = Collision.Distance Then
  216. '    CheckCollision = True
  217. 'ElseIf (Radius + Sphere2Radius) < Collision.Distance Then
  218. '    CheckCollision = False
  219. 'ElseIf (Radius + Sphere2Radius) > Collision.Distance Then
  220. '    CheckCollision = True
  221. 'End If
  222.  
  223. End Function
  224.