home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic Game Programming for Teens / VBGPFT.cdr / sources / chapter14 / CollisionTest / Direct3D.bas < prev    next >
Encoding:
BASIC Source File  |  2004-10-23  |  3.6 KB  |  142 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 DrawSurface(ByRef source As Direct3DSurface8, _
  104.     ByVal lLeft As Long, _
  105.     ByVal lTop As Long, _
  106.     ByVal lRight As Long, _
  107.     ByVal lBottom As Long, _
  108.     ByVal dest As Direct3DSurface8, _
  109.     ByVal destx As Long, _
  110.     ByVal desty As Long)
  111.     
  112.     Dim r As DxVBLibA.RECT
  113.     Dim point As DxVBLibA.point
  114.     Dim desc As D3DSURFACE_DESC
  115.  
  116.     'set dimensions of the source image
  117.     r.Left = lLeft
  118.     r.Top = lTop
  119.     r.Right = lRight
  120.     r.bottom = lBottom
  121.         
  122.     'set the destination point
  123.     point.x = destx
  124.     point.y = desty
  125.     
  126.     'draw the scroll window
  127.     d3ddev.CopyRects source, r, 1, dest, point
  128.  
  129. End Sub
  130.  
  131.  
  132. Public Sub Shutdown()
  133.     Set scrollbuffer = Nothing
  134.     Set tiles = Nothing
  135.     Set d3ddev = Nothing
  136.     Set d3d = Nothing
  137.     Set d3dx = Nothing
  138.     Set dx = Nothing
  139.     End
  140. End Sub
  141.  
  142.