home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic Game Programming for Teens / VBGPFT.cdr / sources / chapter09 / SpriteTest / Direct3D.bas next >
Encoding:
BASIC Source File  |  2004-10-19  |  3.1 KB  |  120 lines
  1. Attribute VB_Name = "Direct3D"
  2. '---------------------------------------------------------------
  3. ' Visual Basic Game Programming for Teens
  4. ' Direct3D Support File
  5. '---------------------------------------------------------------
  6.  
  7. Option Explicit
  8. Option Base 0
  9.  
  10.  
  11. 'the DirectX objects
  12. Public dx As DirectX8
  13. Public d3d As Direct3D8
  14. Public d3dx As New D3DX8
  15. Public dispmode As D3DDISPLAYMODE
  16. Public d3dpp As D3DPRESENT_PARAMETERS
  17. Public d3ddev As Direct3DDevice8
  18. Public backbuffer As Direct3DSurface8
  19.  
  20. Public Sub InitDirect3D(ByVal hwnd As Long, ByVal lWidth As Long, ByVal lHeight As Long, ByVal bFullscreen As Boolean)
  21.     'catch any errors here
  22.     On Local Error GoTo fatal_error
  23.     
  24.     'create the DirectX object
  25.     Set dx = New DirectX8
  26.  
  27.     'create the Direct3D object
  28.     Set d3d = dx.Direct3DCreate()
  29.     If d3d Is Nothing Then
  30.         MsgBox "Error initializing Direct3D!"
  31.         Shutdown
  32.     End If
  33.  
  34.     'tell D3D to use the current color depth
  35.     d3d.GetAdapterDisplayMode D3DADAPTER_DEFAULT, dispmode
  36.     
  37.     'set the display settings used to create the device
  38.     Dim d3dpp As D3DPRESENT_PARAMETERS
  39.     d3dpp.hDeviceWindow = hwnd
  40.     d3dpp.BackBufferCount = 1
  41.     d3dpp.BackBufferWidth = lWidth
  42.     d3dpp.BackBufferHeight = lHeight
  43.     d3dpp.SwapEffect = D3DSWAPEFFECT_COPY_VSYNC
  44.     d3dpp.BackBufferFormat = dispmode.Format
  45.  
  46.     'set windowed or fullscreen mode
  47.     If bFullscreen Then
  48.         d3dpp.Windowed = 0
  49.     Else
  50.         d3dpp.Windowed = 1
  51.     End If
  52.  
  53.     'chapter 9
  54.     d3dpp.MultiSampleType = D3DMULTISAMPLE_NONE
  55.     d3dpp.AutoDepthStencilFormat = D3DFMT_D32
  56.  
  57.     'create the D3D primary device
  58.     Set d3ddev = d3d.CreateDevice( _
  59.         D3DADAPTER_DEFAULT, _
  60.         D3DDEVTYPE_HAL, _
  61.         hwnd, _
  62.         D3DCREATE_SOFTWARE_VERTEXPROCESSING, _
  63.         d3dpp)
  64.         
  65.     If d3ddev Is Nothing Then
  66.         MsgBox "Error creating the Direct3D device!"
  67.         Shutdown
  68.     End If
  69.     
  70.     Exit Sub
  71. fatal_error:
  72.     MsgBox "Critical error in Start_Direct3D!"
  73.     Shutdown
  74. End Sub
  75.  
  76. Public Function LoadSurface( _
  77.     ByVal filename As String, _
  78.     ByVal width As Long, _
  79.     ByVal height As Long) _
  80.     As Direct3DSurface8
  81.     
  82.     On Local Error GoTo fatal_error
  83.     Dim surf As Direct3DSurface8
  84.     
  85.     'return error by default
  86.     Set LoadSurface = Nothing
  87.     
  88.     'create the new surface
  89.     d3d.GetAdapterDisplayMode D3DADAPTER_DEFAULT, dispmode
  90.     Set surf = d3ddev.CreateImageSurface(width, height, dispmode.Format)
  91.     If surf Is Nothing Then
  92.         MsgBox "Error creating surface!"
  93.         Exit Function
  94.     End If
  95.     
  96.     'load surface from file
  97.     d3dx.LoadSurfaceFromFile surf, ByVal 0, ByVal 0, filename, _
  98.         ByVal 0, D3DX_DEFAULT, 0, ByVal 0
  99.         
  100.     If surf Is Nothing Then
  101.         MsgBox "Error loading " & filename & "!"
  102.         Exit Function
  103.     End If
  104.     
  105.     'return the new surface
  106.     Set LoadSurface = surf
  107.  
  108. fatal_error:
  109.     Exit Function
  110. End Function
  111.  
  112. Public Sub Shutdown()
  113.     Set d3ddev = Nothing
  114.     Set d3d = Nothing
  115.     Set d3dx = Nothing
  116.     Set dx = Nothing
  117.     End
  118. End Sub
  119.  
  120.