home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic Game Programming for Teens / VBGPFT.cdr / sources / chapter12 / ViewMap / Direct3D.bas next >
Encoding:
BASIC Source File  |  2004-10-17  |  2.9 KB  |  113 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 windowhandle As Long)
  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.     'set the display settings used to create the device
  31.     Dim d3dpp As D3DPRESENT_PARAMETERS
  32.     d3dpp.hDeviceWindow = windowhandle
  33.     d3dpp.BackBufferCount = 1
  34.     d3dpp.BackBufferWidth = SCREENWIDTH
  35.     d3dpp.BackBufferHeight = SCREENHEIGHT
  36.     d3dpp.SwapEffect = D3DSWAPEFFECT_COPY_VSYNC
  37.     
  38.     'tell D3D to use the current color depth
  39.     d3d.GetAdapterDisplayMode D3DADAPTER_DEFAULT, dispmode
  40.     d3dpp.BackBufferFormat = dispmode.Format
  41.  
  42.     'set windowed or fullscreen mode
  43.     If FULLSCREEN Then
  44.         d3dpp.Windowed = 0
  45.     Else
  46.         d3dpp.Windowed = 1
  47.     End If
  48.  
  49.     'create the D3D primary device
  50.     Set d3ddev = d3d.CreateDevice( _
  51.         D3DADAPTER_DEFAULT, _
  52.         D3DDEVTYPE_HAL, _
  53.         hWnd, _
  54.         D3DCREATE_SOFTWARE_VERTEXPROCESSING, _
  55.         d3dpp)
  56.         
  57.     If d3ddev Is Nothing Then
  58.         MsgBox "Error creating the Direct3D device!"
  59.         Shutdown
  60.     End If
  61.     
  62.     Exit Sub
  63. fatal_error:
  64.     MsgBox "Critical error in Start_Direct3D!"
  65.     Shutdown
  66. End Sub
  67.  
  68. Public Function LoadSurface( _
  69.     ByVal filename As String, _
  70.     ByVal width As Long, _
  71.     ByVal height As Long) _
  72.     As Direct3DSurface8
  73.     
  74.     On Local Error GoTo fatal_error
  75.     Dim surf As Direct3DSurface8
  76.     
  77.     'return error by default
  78.     Set LoadSurface = Nothing
  79.     
  80.     'create the new surface
  81.     Set surf = d3ddev.CreateImageSurface(width, height, dispmode.Format)
  82.     If surf Is Nothing Then
  83.         MsgBox "Error creating surface!"
  84.         Exit Function
  85.     End If
  86.     
  87.     'load surface from file
  88.     d3dx.LoadSurfaceFromFile surf, ByVal 0, ByVal 0, filename, _
  89.         ByVal 0, D3DX_DEFAULT, 0, ByVal 0
  90.         
  91.     If surf Is Nothing Then
  92.         MsgBox "Error loading " & filename & "!"
  93.         Exit Function
  94.     End If
  95.     
  96.     'return the new surface
  97.     Set LoadSurface = surf
  98.  
  99. fatal_error:
  100.     Exit Function
  101. End Function
  102.  
  103. Public Sub Shutdown()
  104.     Set scrollbuffer = Nothing
  105.     Set tiles = Nothing
  106.     Set d3ddev = Nothing
  107.     Set d3d = Nothing
  108.     Set d3dx = Nothing
  109.     Set dx = Nothing
  110.     End
  111. End Sub
  112.  
  113.