home *** CD-ROM | disk | FTP | other *** search
/ Planet Source Code Jumbo …e CD Visual Basic 1 to 7 / 5_2007-2008.ISO / data / Zips / Blank_Engi2067755272007.psc / BlankEngine / BE_BillBoard.bas < prev    next >
BASIC Source File  |  2007-02-02  |  7KB  |  217 lines
  1. Attribute VB_Name = "BE_BillBoard"
  2. '//
  3. '// BE_BillBoard handles billboard rendering
  4. '//
  5.  
  6. Private Declare Function GetTickCount Lib "kernel32" () As Long
  7.  
  8. 'Billlboard stuff
  9. Public BE_BILLBOARD_FACE As D3DVECTOR
  10. Public BE_BILLBOARD_POSX As Single
  11. Public BE_BILLBOARD_POSY As Single
  12. Public BE_BILLBOARD_POSZ As Single
  13. Private BBSize As Single
  14. Private CurrentFrame As Integer
  15. Private TotalFrames As Integer
  16.  
  17. 'Billboard frames
  18. Private BBinterval As Integer
  19. Private LastCheck As Long
  20.  
  21. 'Billboarding angles
  22. Private BBphi As Single
  23. Private BBtheta As Single
  24.  
  25. 'billboard texture
  26. Private TexBillboard() As Direct3DTexture8
  27.  
  28. Public Function BE_BILLBOARD_INIT(TexturePath() As String, Interval As Integer, Position As D3DVECTOR, Width As Long, Height As Long, Depth As CONST_D3DFORMAT, Size As Integer) As Boolean
  29. 'initialize billboard
  30. On Error GoTo Err
  31.  
  32. Dim i As Integer
  33.  
  34.     'load all of the textures
  35.     For i = LBound(TexturePath) To UBound(TexturePath)
  36.         'resize variable
  37.         ReDim Preserve TexBillboard(0 To i) As Direct3DTexture8
  38.         
  39.         'load texture
  40.         If D3D.CheckDeviceFormat(0, D3DDEVTYPE_HAL, Depth, 0, D3DRTYPE_TEXTURE, D3DFMT_A8R8G8B8) = D3D_OK Then
  41.             Set TexBillboard(i) = D3DX.CreateTextureFromFileEx(D3Device, App.Path & TexturePath(i), Width, Height, 1, 0, D3DFMT_A8R8G8B8, D3DPOOL_MANAGED, D3DX_FILTER_LINEAR, D3DX_FILTER_LINEAR, 0, ByVal 0, ByVal 0)
  42.         ElseIf D3D.CheckDeviceFormat(0, D3DDEVTYPE_HAL, Depth, 0, D3DRTYPE_TEXTURE, D3DFMT_A4R4G4B4) = D3D_OK Then
  43.             Set TexBillboard(i) = D3DX.CreateTextureFromFileEx(D3Device, App.Path & TexturePath(i), Width, Height, 1, 0, D3DFMT_A4R4G4B4, D3DPOOL_MANAGED, D3DX_FILTER_LINEAR, D3DX_FILTER_LINEAR, 0, ByVal 0, ByVal 0)
  44.         ElseIf D3D.CheckDeviceFormat(0, D3DDEVTYPE_HAL, Depth, 0, D3DRTYPE_TEXTURE, D3DFMT_A1R5G5B5) = D3D_OK Then
  45.             Set TexBillboard(i) = D3DX.CreateTextureFromFileEx(D3Device, App.Path & TexturePath(i), Width, Height, 1, 0, D3DFMT_A1R5G5B5, D3DPOOL_MANAGED, D3DX_FILTER_LINEAR, D3DX_FILTER_LINEAR, 0, ByVal 0, ByVal 0)
  46.         Else
  47.             GoTo Err
  48.         End If
  49.     Next i
  50.     
  51.     'set up billboard
  52.     BBinterval = Interval
  53.     LastCheck = GetTickCount()
  54.     BE_BILLBOARD_POSX = Position.X: BE_BILLBOARD_POSY = Position.Y
  55.     BE_BILLBOARD_POSZ = Position.Z
  56.     TotalFrames = UBound(TexBillboard)
  57.     CurrentFrame = 0
  58.     BBSize = Size
  59.  
  60.     'exit
  61.     BE_BILLBOARD_INIT = True
  62.     Exit Function
  63.     
  64. Err:
  65. 'send to logger
  66.     BE_BILLBOARD_INIT = False
  67.     Logger.BE_LOGGER_SAVE_LOG "Error[" & Err.Number & "] " & Err.Source & "{BE_BILLBOARD_INIT} : " & Err.Description, App.Path & "\Log.txt"
  68. End Function
  69.  
  70. Public Sub BE_BILLBOARD_SETUP_RENDER(Angle As Single)
  71. 'draw the billboard
  72. On Error GoTo Err
  73.  
  74.     'find the angles for the billboard
  75.     BE_BILLBOARD_FIND_ANGLES BE_BILLBOARD_FACE, BE_VERTEX_MAKE_VECTOR(1, 10, 10)
  76.     
  77.     'draw
  78.     BE_BILLBOARD_RENDER
  79.     Exit Sub
  80.     
  81. Err:
  82. 'send to logger
  83.     Logger.BE_LOGGER_SAVE_LOG "Error[" & Err.Number & "] " & Err.Source & "{BE_BILLBOARD_RENDER} : " & Err.Description, App.Path & "\Log.txt"
  84. End Sub
  85.  
  86. Private Sub BE_BILLBOARD_RENDER()
  87. 'Actually draws the billboard
  88. On Error GoTo Err
  89.  
  90.     ' setup device
  91.     D3Device.SetVertexShader Unlit_FVF
  92.     D3Device.SetRenderState D3DRS_ALPHATESTENABLE, 1 'alpha testing is useful... ;)
  93.     D3Device.SetRenderState D3DRS_ALPHAFUNC, D3DCMP_GREATEREQUAL 'Pixel passes if (pxAlpha>=ALPHAREF)
  94.     D3Device.SetRenderState D3DRS_ALPHAREF, 50 'only if the pixels alpha is greater than or equal to 50 will it be rendered (skips lots of rendering!)
  95.     D3Device.SetRenderState D3DRS_ZWRITEENABLE, 0 'we dont want to affect the depth buffer
  96.     
  97.     'find frame
  98.     If (GetTickCount - LastCheck >= BBinterval) Then
  99.         'advance frame
  100.         CurrentFrame = CurrentFrame + 1
  101.         LastCheck = GetTickCount()
  102.         If CurrentFrame > TotalFrames Then CurrentFrame = 0
  103.     End If
  104.     
  105.     'setup billboard rotation
  106.     Dim Z(0 To 3) As Single
  107.     Z(0) = BECamera.BE_CAMERA_STRAFE - BE_BILLBOARD_POSX
  108.     Z(1) = BECamera.BE_CAMERA_STRAFE - BE_BILLBOARD_POSX
  109.     Z(2) = BECamera.BE_CAMERA_HEIGHT - BE_BILLBOARD_POSZ
  110.     Z(3) = BECamera.BE_CAMERA_HEIGHT - BE_BILLBOARD_POSZ
  111.         
  112.     'draw texture
  113.     BE_IMAGE_RENDER_BILLBOARD BE_BILLBOARD_POSITION.X, BE_BILLBOARD_POSITION.Y, BE_BILLBOARD_POSITION.Z, Z(), BBSize, TexBillboard(CurrentFrame)
  114.     
  115.     'tidy up device
  116.     D3Device.SetRenderState D3DRS_ALPHATESTENABLE, 0
  117.     D3Device.SetRenderState D3DRS_ZWRITEENABLE, 1
  118.     
  119.     'exit
  120.     Exit Sub
  121.     
  122. Err:
  123. 'send to logger
  124.     Logger.BE_LOGGER_SAVE_LOG "Error[" & Err.Number & "] " & Err.Source & "{BE_BILLBOARD_RENDER} : " & Err.Description, App.Path & "\Log.txt"
  125. End Sub
  126.  
  127. Public Sub BE_BILLBOARD_FIND_ANGLES(vFrom As D3DVECTOR, vTo As D3DVECTOR)
  128. '//Finds the angles required to set up the correct
  129. '//billboard rotations. Written by Eric Coleman (thanks!)
  130.  
  131. Dim vN As D3DVECTOR
  132. Dim R As Single, temp As Single
  133.  
  134. '//1. Calc. Vector from Cam->BBoard
  135.     vN.X = -vTo.X + vFrom.X
  136.     vN.Y = -vTo.Y + vFrom.Y
  137.     vN.Z = -vTo.Z + vFrom.Z
  138.     
  139. '//2. Convert to spherical Coords
  140.     R = Sqr(vN.X * vN.X + vN.Y * vN.Y + vN.Z * vN.Z)
  141.     
  142.     temp = vN.Z / R
  143.     If temp = 1 Then
  144.       BBphi = 0
  145.     ElseIf temp = -1 Then
  146.       BBphi = Pi
  147.     Else
  148.       BBphi = Atn(-temp / Sqr(-temp * temp + 1)) + (Pi / 2)
  149.     End If
  150.     
  151.     temp = vN.X / (R * Sin(BBphi))
  152.     If temp = 1 Then
  153.       BBtheta = 0
  154.     ElseIf temp = -1 Then
  155.       BBtheta = Pi
  156.     Else
  157.       BBtheta = Atn(-temp / Sqr(Abs(-temp * temp + 1))) + (Pi / 2)
  158.     End If
  159.     
  160.     If vN.Y < 0 Then
  161.        BBtheta = -BBtheta
  162.     End If
  163.  
  164. End Sub
  165.  
  166. Public Sub BE_BILLBOARD_GENERATE_BBMATRIX(Index As Long)
  167. '// generate billboard matrix
  168. Dim tempMatrix As D3DMATRIX
  169. Dim tempMatrix2 As D3DMATRIX
  170.  
  171.     D3DXMatrixIdentity matWorld
  172.     D3DXMatrixIdentity tempMatrix
  173.  
  174.     D3DXMatrixRotationY tempMatrix, BBphi
  175.     D3DXMatrixRotationZ tempMatrix2, BBtheta
  176.  
  177.     D3DXMatrixMultiply matWorld, tempMatrix, tempMatrix2
  178.  
  179.     matWorld.m41 = ExpTranslate(Index).X
  180.     matWorld.m42 = ExpTranslate(Index).Y
  181.     matWorld.m43 = ExpTranslate(Index).Z
  182.  
  183.     D3Device.SetTransform D3DTS_WORLD, matWorld
  184. End Sub
  185.  
  186. Public Sub BE_BILLBOARD_UNLOAD()
  187. '// Unload the currently loaded billboard
  188. On Error GoTo Err
  189.  
  190. Dim i As Integer
  191.  
  192.     'unload textures
  193.     For i = 0 To TotalFrames
  194.         Set TexBillboard(i) = Nothing
  195.     Next i
  196.     
  197.     'resize variables
  198.     ReDim TexBillboard(0) As Direct3DTexture8
  199.     
  200.     'unload other variables
  201.     CurrentFrame = 0
  202.     TotalFrames = 0
  203.     BBphi = 0
  204.     BBtheta = 0
  205.     BE_BILLBOARD_FACE.X = 0: BE_BILLBOARD_FACE.Y = 0: BE_BILLBOARD_FACE.Z = 0
  206.     BE_BILLBOARD_POSX = 0: BE_BILLBOARD_POSY = 0: BE_BILLBOARD_POSZ = 0
  207.     BBinterval = 0
  208.     LastCheck = 0
  209.     
  210.     'exit
  211.     Exit Sub
  212.  
  213. Err:
  214. 'send to logger
  215.     Logger.BE_LOGGER_SAVE_LOG "Error[" & Err.Number & "] " & Err.Source & "{BE_BILLBOARD_UNLOAD} : " & Err.Description, App.Path & "\Log.txt"
  216. End Sub
  217.