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