home *** CD-ROM | disk | FTP | other *** search
/ Microsoft DirectX SDK 7.0 / Dx7.bin / DXF / samples / multimedia / vbsamples / d3dim / src / imcontrol / im.cls < prev    next >
Encoding:
Visual Basic class definition  |  1999-03-09  |  28.7 KB  |  975 lines

  1. VERSION 1.0 CLASS
  2. BEGIN
  3.   MultiUse = -1  'True
  4. END
  5. Attribute VB_Name = "IMClass"
  6. Attribute VB_GlobalNameSpace = False
  7. Attribute VB_Creatable = True
  8. Attribute VB_PredeclaredId = False
  9. Attribute VB_Exposed = False
  10. '
  11. ' DIRECT3D IM SETUP USING DIRECTDRAW4 and DIRECT3D3
  12. '
  13. '
  14.  
  15. Option Explicit
  16.  
  17. Private Declare Function GetWindowRect Lib "user32.dll" (ByVal hwnd As Long, ByRef r As RECT) As Long
  18.  
  19.                                             
  20. '- Public Variables
  21. '
  22. Public Dx As DirectX7                       '- DirectX globals object
  23. Public dd As DirectDraw4                    '- DirectDraw      object
  24. Public d3d As Direct3D3                     '- Direct3D        object
  25. Public d3dViewport As Direct3DViewport3     '- Direct3DViewport
  26. Public d3dDevice As Direct3DDevice3         '- Direct3DDevice
  27. Public screenSurface As DirectDrawSurface4  '- DirectDrawSurface representing the screen
  28. Public backSurface As DirectDrawSurface4    '- DirectDrawSurface representing our window
  29. Public ZBuffer As DirectDrawSurface4        '- Surface: ZBuffer used for 3d
  30.  
  31.  
  32.  
  33. '- Private Variables
  34. '
  35.                                             '- State set by init funtions
  36. Dim m_bUseVMem As Boolean                   '- Try Video memory. influences m_memtype
  37. Dim m_bSoftwareOnly As Boolean              '- Do not attempt to use HW if this is set
  38. Dim m_strTry3dDevGuid As String             '- If not "" then try to set up 3d hardware
  39. Dim m_bUse3d As Boolean                     '- Setup surfaces for 2d only                                            '  with this guid as opposed to finding one
  40. Dim m_bCreateViewport As Boolean            '- Create a default viewport
  41. Dim m_bUseZBuffer As Boolean                '- try to use a zbuffer
  42. Dim m_bTLVertices As Boolean                '- set to true if vieport is to be setup
  43.                                             '  for only Transoformed an lit Vertices
  44. Dim m_bIsfullscreen As Boolean              '- Are we running full screen?
  45.  
  46.  
  47.                                             '- DirectDraw state
  48. Dim m_memtype As Long                       '- Indicates if we want our surfaces in
  49.                                             '  System Memory or in VideoMemory
  50.                                             '  For 3d im to run full screen
  51.                                             '  and accelerated all surfaces
  52.                                             '  must be in video memory
  53. Dim m_hwnd As Long                          '- Hwnd we use for clipping
  54.                                             '  for full screen this is the FSWindow
  55.                                             '  for windowed this is the controls hwnd
  56. Dim m_backRect As RECT                      '- Rectange describing back buffer
  57. Dim m_bpp As Integer                        '- Bits per pixel we are in
  58. Dim m_height As Integer                     '- Height of back buffer
  59. Dim m_width As Integer                      '- Width of back buffer
  60. Dim m_ddsdBack As DDSURFACEDESC2            '- Desc of the Back Buffer
  61. Dim m_ddsdScreen As DDSURFACEDESC2          '- Desc of the Screen Buffer
  62. Dim m_bddinit As Boolean                    '- Has DirectDraw been initialized?
  63. Dim m_strDDDevGuid As String                '- GUID for DirectDraw device in use
  64.  
  65.                                             '- Direct3D state
  66. Dim m_bHW As Boolean                        '- 3d device in use is HardWare device
  67. Dim m_str3dDevGuid As String                '- GUID of enumerated 3d Device (usually hw)
  68. Dim m_str3dFallbackGuid As String           '- GUID of Software fallback device
  69. Dim m_strActiveDevGuid As String            '- GUID of device in use
  70.  
  71. Dim m_str3dDevDesc As String                '- Readable description of best match 3d Device
  72. Dim m_str3dFallbackDesc As String           '- Readable description of sofrware fallback dev.
  73. Dim m_strActiveDevDesc As String            '- Readable description of device in use
  74.  
  75. Dim m_hwEnabled As Boolean                  '- 3d HW device found and in use
  76. Dim m_bNoZBuffer As Boolean
  77. Dim m_d3dFlags As Long                      '- flags needed createSurface
  78.  
  79. '-=========================================
  80. '  Init
  81. '
  82. '  note:  pass in "" for default
  83. '         sets the directDrawguid to be used
  84. '-=========================================
  85. Public Function Init(sguid As String) As Boolean
  86.     On Local Error GoTo errOut
  87.     
  88.     
  89.     Set Dx = New DirectX7
  90.     Set dd = Dx.DirectDrawCreate(sguid)
  91.     m_strDDDevGuid = sguid
  92.         
  93.     Init = True
  94.     Exit Function
  95.     
  96. errOut:
  97.     Init = False
  98.     DebugLog " DirectDraw failed to initialize your card may not have DirectDraw drivers installed"
  99. End Function
  100.  
  101.  
  102. '-=========================================
  103. '  Start
  104. '       hwnd        - SetCooperativeLevel Hwnd
  105. '       bFullscreen - Start fullscreen mode
  106. '       bUse3D      - (TRUE) unless you just want 2d support
  107. '       bTryVMem    - (FALSE only if TRUE fails)
  108. '
  109. '  NOTE: make sure all surfaces are destroyed
  110. '  before calling start as start will fail otherwise
  111. '
  112. '-=========================================
  113.  
  114. Public Function Start(hwnd As Long, bFullScreen As Boolean, bUse3D As Boolean, bTryVMem As Boolean) As Boolean
  115.     On Local Error GoTo errOut
  116.     Dim b As Boolean
  117.     
  118.     'Free our existing back and screen buffer
  119.     Set backSurface = Nothing
  120.     Set screenSurface = Nothing
  121.     
  122.     
  123.     '-Save our inputs as State
  124.     m_hwnd = hwnd
  125.     m_bIsfullscreen = bFullScreen
  126.     m_bUse3d = bUse3D
  127.     m_bUseVMem = bTryVMem
  128.         
  129.     '- Our Surfaces are going to have to be created in video memory
  130.     '  or in System memory. We let the user decide but keep in mind
  131.     '  to have FS or HW work things need to be in VIDEO memory
  132.     '  we later pass these flags to createSurface
  133.     '
  134.     If m_bUseVMem Then
  135.         m_memtype = DDSCAPS_VIDEOMEMORY
  136.     Else
  137.         m_memtype = DDSCAPS_SYSTEMMEMORY
  138.     End If
  139.     
  140.     '- More flags we pass to createSurface
  141.     '  3DDEVICE needs to be set to create as surface that
  142.     '  the 3d immediate mode can render to
  143.     '
  144.     If m_bUse3d Then
  145.         m_d3dFlags = DDSCAPS_3DDEVICE
  146.     Else
  147.         m_d3dFlags = 0
  148.     End If
  149.             
  150.             
  151.     '- Running Full screen and running windowed follow
  152.     '  very different code paths to setup directDraw
  153.     '  These functions simply create DirectDrawSurfaces
  154.     '  to render to.
  155.     If m_bIsfullscreen Then
  156.         b = InitFullScreen()
  157.     Else
  158.         b = InitWindowed()
  159.     End If
  160.     
  161.     '- If we failed our DirectDrawSurface creation
  162.     '  then clean up and exit
  163.     If b = False Then
  164.         DebugLog "DirectDraw was unable to create the necessary surfaces to continue"
  165.         Start = False
  166.         Cleanup
  167.         Exit Function
  168.     End If
  169.     
  170.     'NOTE: if we where to support palettized modes we should
  171.     '      attach palettes to our primary and back buffer here!!!
  172.     
  173.     
  174.     DebugLog "DirectDraw SURFACES OK"
  175.     
  176.     '- More 3d Setup
  177.     
  178.     If m_bUse3d = True Then
  179.         
  180.         '- We get our D3D object for our DirectDraw object
  181.         '  (remember that the direct draw object is analogous
  182.         '   to your VideoCard- 1 object per card)
  183.         Set d3d = dd.GetDirect3D
  184.         
  185.         '- If the user hasnt set a prefered device GUID
  186.         '  then we go find one
  187.         '  and initialize the m_strGuid state members
  188.         If m_str3dDevGuid = "" Then
  189.             EnumDevices
  190.         End If
  191.         
  192.                 
  193.         '- Now that our Front and Back Buffer are created we need
  194.         '  a ZBuffer
  195.         b = AttatchZBuffer()
  196.         If b = False Then
  197.              GoTo errOut
  198.         End If
  199.     
  200.         
  201.         '- Create the Direct3DDevice
  202.         '  use the device guids we enumerated to pick the device
  203.         b = CreateIMDevice()
  204.          If b = False Then
  205.          
  206.             '- If we failed try and fall back using the
  207.             '  Software device guids
  208.             b = CreateIMSoftwareDevice()
  209.             If b = False Then GoTo errOut
  210.         End If
  211.         
  212.         '- Create a default viewport
  213.         If m_bCreateViewport Then
  214.             b = CreateViewport(m_width, m_height)
  215.             If b = False Then GoTo errOut
  216.         End If
  217.             
  218.     End If
  219.     Start = True
  220.     Exit Function
  221.     
  222.     
  223.     
  224. errOut:
  225.     Start = False
  226.     Cleanup
  227. End Function
  228.  
  229.  
  230.  
  231.  
  232. '-=========================================
  233. '  CreateIMDevice
  234. '-=========================================
  235.  
  236. Private Function CreateIMDevice() As Boolean
  237.     On Local Error GoTo errOut
  238.     
  239.     '- If the user gave us a guid to try try it first
  240.     If m_strTry3dDevGuid <> "" Then
  241.         Set d3dDevice = d3d.CreateDevice(m_strTry3dDevGuid, backSurface)
  242.         m_strActiveDevGuid = m_strTry3dDevGuid
  243.         m_strActiveDevDesc = ""
  244.     
  245.     '- other wise use m_str3dDevGuid which EnumDevices filled in.
  246.     '  note call CreateIMSoftwareDevice if they explictly want Software
  247.     Else
  248.         If m_bSoftwareOnly Then GoTo errOut
  249.         Set d3dDevice = d3d.CreateDevice(m_str3dDevGuid, backSurface)
  250.         m_strActiveDevGuid = m_str3dDevGuid
  251.         m_strActiveDevDesc = m_str3dDevDesc
  252.     End If
  253.     
  254.     CreateIMDevice = True
  255.     Exit Function
  256.  
  257. errOut:
  258.     CreateIMDevice = False
  259.     m_strActiveDevGuid = ""
  260.     m_strActiveDevDesc = ""
  261.  
  262. End Function
  263.  
  264.  
  265.  
  266. '-=========================================
  267. '  CreateIMSoftwareDevice
  268. '
  269. '  note: should call EnumDevices before
  270. '        attempting this call
  271. '        EnumDevices fills in m_str3dFallbackGuid
  272. '-=========================================
  273.  
  274. Private Function CreateIMSoftwareDevice() As Boolean
  275.     If m_str3dFallbackGuid = "" Then Exit Function
  276.     On Local Error GoTo errOut
  277.     Set d3dDevice = d3d.CreateDevice(m_str3dFallbackGuid, backSurface)
  278.     m_strActiveDevGuid = m_str3dFallbackGuid
  279.     m_strActiveDevDesc = m_str3dFallbackDesc
  280.  
  281.     CreateIMSoftwareDevice = True
  282.     Exit Function
  283. errOut:
  284.     m_strActiveDevGuid = ""
  285.     m_strActiveDevDesc = ""
  286.  
  287.     CreateIMSoftwareDevice = False
  288. End Function
  289.  
  290.  
  291.  
  292. '-=========================================
  293. '  SetDisplayMode
  294. '
  295. '  note: only used in FullScreen modes
  296. '        call prior to Start to select the resolution
  297. '        or after to change the resoultion after the fact
  298. '
  299. '-=========================================
  300. Public Function SetDisplayMode(width As Integer, height As Integer, bpp As Integer) As Boolean
  301.     On Local Error GoTo errOut
  302.     
  303.     If m_bIsfullscreen And m_bddinit Then
  304.         dd.SetDisplayMode width, height, bpp, 0, 0
  305.     End If
  306.     
  307.     m_bpp = bpp
  308.     m_height = height
  309.     m_width = width
  310.     
  311.     SetDisplayMode = True
  312.     Exit Function
  313.     
  314. errOut:
  315.     SetDisplayMode = False
  316. End Function
  317.  
  318. '-=========================================
  319. '  InitFullScreen
  320. '
  321. '  sets up DirectDrawSurfaces for Fullscreen
  322. '  viewing
  323. '
  324. '-=========================================
  325.  
  326. Private Function InitFullScreen() As Boolean
  327.     On Local Error GoTo errOut
  328.     Dim e As Long
  329.     
  330.     '- Setting the CooperativeLevel
  331.     '  Modex allows us to change display modes
  332.     '  Exclusive allows us to perform flip operations
  333.     '  and indicates we dont want windows to get in the way
  334.     DebugLog "set Cooperitive level - about " + Str(m_hwnd)
  335.     dd.SetCooperativeLevel m_hwnd, DDSCL_NOWINDOWCHANGES Or DDSCL_FULLSCREEN Or DDSCL_ALLOWMODEX Or DDSCL_EXCLUSIVE
  336.     'dd.SetCooperativeLevel m_hwnd, DDSCL_FULLSCREEN Or DDSCL_EXCLUSIVE
  337.         
  338.     '- If we got this fare we succeeded in Initilalizing DirectDraw
  339.     m_bddinit = True
  340.     DebugLog "set Cooperitive level ok"
  341.             
  342.             
  343.     If m_width <> 0 And m_height <> 0 And m_bpp <> 0 Then
  344.         SetDisplayMode m_width, m_height, m_bpp
  345.     End If
  346.         
  347.     '- Get the SCREEN SURFACE and create a back buffer too
  348.     '  the DDSCAPS_FLIP us to call flip and swap the
  349.     '  front and back buffers for fast rendering
  350.     DebugLog "mem type" + Str(m_memtype)
  351.     m_ddsdScreen.lFlags = DDSD_CAPS Or DDSD_BACKBUFFERCOUNT
  352.     m_ddsdScreen.ddsCaps.lCaps = DDSCAPS_PRIMARYSURFACE Or DDSCAPS_FLIP Or DDSCAPS_COMPLEX Or m_d3dFlags Or m_memtype
  353.     m_ddsdScreen.lBackBufferCount = 1
  354.     Set screenSurface = dd.CreateSurface(m_ddsdScreen)
  355.     
  356.     DebugLog "created Primary OK"
  357.     
  358.     '- Get the BACK SURFACE we render to
  359.     '  since the back buffer is already attached
  360.     '  all we need to do is get a reference to it
  361.     Dim caps As DDSCAPS2
  362.     caps.lCaps = DDSCAPS_BACKBUFFER
  363.     Set backSurface = screenSurface.GetAttachedSurface(caps)
  364.     
  365.     DebugLog "Got Backbuffer OK"
  366.     
  367.     '- Get some default info about the back surface
  368.     backSurface.GetSurfaceDesc m_ddsdBack
  369.     m_width = m_ddsdBack.lWidth
  370.     m_height = m_ddsdBack.lHeight
  371.     m_bpp = m_ddsdBack.ddpfPixelFormat.lRGBBitCount
  372.     
  373.     '- Indicate our surfaces are setup for full screen operation
  374.     m_bIsfullscreen = True
  375.     
  376.     InitFullScreen = True
  377.     Exit Function
  378.  
  379. errOut:
  380.     e = Error.Number
  381.     Call dd.SetCooperativeLevel(m_hwnd, DDSCL_NORMAL)
  382.     dd.RestoreDisplayMode
  383.     Debug.Print "InitFullScreen failed" + Str(e)
  384.     
  385.  
  386. End Function
  387.  
  388. '-=========================================
  389. '  InitWindowed
  390. '
  391. '  sets up DirectDrawSurfaces for a Window
  392. '
  393. '-=========================================
  394. Private Function InitWindowed() As Boolean
  395.     On Local Error GoTo errOut
  396.     Dim b As Boolean
  397.     
  398.     '- Set DirectDraw Cooperative Level to normal
  399.     Call dd.SetCooperativeLevel(m_hwnd, DDSCL_NORMAL)
  400.     m_bddinit = True
  401.     
  402.         
  403.     '- get the SCREEN SURFACE
  404.     m_ddsdScreen.lFlags = DDSD_CAPS
  405.     m_ddsdScreen.ddsCaps.lCaps = DDSCAPS_PRIMARYSURFACE
  406.     Set screenSurface = dd.CreateSurface(m_ddsdScreen)
  407.             
  408.     
  409.     '- Create a clipper object that tracks our window
  410.     '  when the clipper is attached to the primary(screen)
  411.     '  any blts to the primary will be "clipped" by
  412.     '  a rectangle defined by our window.
  413.     '  also if the window is minimized nothing is blt
  414.     '  and if the window is obscured by another only
  415.     '  the visible portion of our window will be blt to
  416.     '
  417.     Dim clip As DirectDrawClipper
  418.     Set clip = dd.CreateClipper(0)
  419.     clip.SetHWnd m_hwnd
  420.     screenSurface.SetClipper clip
  421.     
  422.     
  423.     '- create a Backbuffer
  424.     CreateOffscreenBackBuffer
  425.         
  426.     
  427.     InitWindowed = True
  428.     Exit Function
  429.                     
  430. errOut:
  431.     InitWindowed = False
  432. End Function
  433.  
  434.  
  435.  
  436. '-=========================================
  437. '  CreateOffscreenBackBuffer
  438. '
  439. '  helper for InitWindowed
  440. '
  441. '-=========================================
  442. Private Function CreateOffscreenBackBuffer()
  443.     
  444.     '- release existing backbuffer
  445.     Set backSurface = Nothing
  446.     
  447.     '- Get dimensions of our destination window
  448.     GetWindowRect m_hwnd, m_backRect
  449.     
  450.     '- create the back surface to fit the window
  451.     m_ddsdBack.lFlags = DDSD_CAPS Or DDSD_HEIGHT Or DDSD_WIDTH
  452.     m_ddsdBack.ddsCaps.lCaps = m_memtype Or DDSCAPS_OFFSCREENPLAIN Or m_d3dFlags
  453.     m_ddsdBack.lWidth = m_backRect.right - m_backRect.left
  454.     m_ddsdBack.lHeight = m_backRect.bottom - m_backRect.top
  455.         
  456.     Set backSurface = dd.CreateSurface(m_ddsdBack)
  457.     
  458.     
  459.     'Safe some state - TODO
  460.     m_width = m_ddsdBack.lWidth
  461.     m_height = m_ddsdBack.lHeight
  462.     m_bpp = m_ddsdBack.ddpfPixelFormat.lRGBBitCount
  463.     
  464.     
  465. End Function
  466.  
  467.  
  468. '-=========================================
  469. '  UpdateScreen
  470. '
  471. '  CONSIDER: removing DDBLT_WAIT flag
  472. '            and optimizing speed
  473. '-=========================================
  474. Public Function UpdateScreen() As Boolean
  475.     On Local Error GoTo errOut
  476.     Dim destRect As RECT
  477.     
  478.     If m_bIsfullscreen Then
  479.     
  480.         ' Flip back buffer to front
  481.         screenSurface.Flip Nothing, DDFLIP_WAIT
  482.         
  483.     Else
  484.         Dim srcRect As RECT
  485.                 
  486.         'get Rectangle describing backbuffer
  487.         srcRect.bottom = m_ddsdBack.lHeight
  488.         srcRect.right = m_ddsdBack.lWidth
  489.         
  490.         'Get rectangle of or window and blt our back buffer
  491.         'to the screen (through the clipper)
  492.         GetWindowRect m_hwnd, destRect
  493.         screenSurface.Blt destRect, backSurface, srcRect, DDBLT_WAIT
  494.                 
  495.     End If
  496.     
  497. errOut:
  498.  
  499. End Function
  500.  
  501. '-=========================================
  502. '  Resize
  503. '
  504. '  call when our hWnd changes size
  505. '  to recongifure the back buffer.
  506. '  be aware that content may fallback to Software
  507. '  if there is not enought video memory.
  508. '
  509. '  TODO: currently once a fallback to software
  510. '  rasterization occurs
  511. '  we no longer attempt to use HW.
  512. '-=========================================
  513. Public Function Resize() As Boolean
  514.     
  515.     Dim b As Boolean
  516.     
  517.     '- want to see how many resize calls we get
  518.     DebugLog "RESIZE" + Str(Timer)
  519.     
  520.     '- Full screen apps must use SetDisplayMode instaed
  521.     If m_bIsfullscreen = True Then
  522.         DebugLog "Must use SetDisplayMode to change size when in full screen"
  523.         Exit Function
  524.     End If
  525.     
  526.     '- Create a new back buffer
  527.     If CreateNewRenderTarget() = False Then
  528.         
  529.         'TODO:
  530.         '- If that fails try system memory
  531.         '  m_memtype = DDSCAPS_SYSTEMMEMORY
  532.         '  If CreateNewRenderTarget() = False Then
  533.         '    DebugLog "cant resize the viewport"
  534.         '    Resize = False
  535.         '  End If
  536.         Exit Function
  537.     End If
  538.     Resize = True
  539. End Function
  540.  
  541. '-=========================================
  542. '- CreateNewRenderTarget
  543. '-=========================================
  544. Function CreateNewRenderTarget() As Boolean
  545.     
  546.     On Local Error GoTo errOut
  547.     Dim b As Boolean
  548.         
  549.     
  550.     '- create new back buffer from our hwnd
  551.     '  sets m_width and m_height from hwnd
  552.     CreateOffscreenBackBuffer
  553.     
  554.     '- Skip if we dont need 3d
  555.     If m_bUse3d = True Then
  556.     
  557.         '- Attach a new zbuffer
  558.         b = AttatchZBuffer()
  559.         If b = False Then GoTo errOut
  560.         
  561.         '- Set the new back buffer as our render target
  562.         d3dDevice.SetRenderTarget backSurface
  563.         
  564.         '- create viewport
  565.         If m_bCreateViewport Then
  566.             b = CreateViewport(m_width, m_height)
  567.             If b = False Then GoTo errOut
  568.         End If
  569.         
  570.     End If
  571.     CreateNewRenderTarget = True
  572.     Exit Function
  573. errOut:
  574.     CreateNewRenderTarget = False
  575.     Set backSurface = Nothing
  576.     Set ZBuffer = Nothing
  577. End Function
  578.  
  579.  
  580.  
  581.  
  582. '-=========================================
  583. '- AttatchZBuffer
  584. '
  585. '  (A ZBuffer holds state for every pixel rendered
  586. '  indicating what depth the rendered pixel is supposed to
  587. '  represent so that when pixels are rendered on top of it
  588. '  the rendered can decide if the new pixel is behind the
  589. '  all ready rendered one)
  590. '
  591. '-=========================================
  592. Function AttatchZBuffer() As Boolean
  593.     On Local Error GoTo errOut
  594.             
  595.     If m_bUseZBuffer = False Then
  596.         AttatchZBuffer = True
  597.         Exit Function
  598.     End If
  599.     
  600.     
  601.     Dim hr As Integer
  602.     Dim ddsZBuff  As DirectDrawSurface4
  603.     Dim ddsd As DDSURFACEDESC2
  604.     Dim ddsd2 As DDSURFACEDESC2
  605.     
  606.     Dim l As Long
  607.     Dim i As Long
  608.  
  609.     '- look for a 16 bit z buffer formats
  610.     '  each card suports only certain formats
  611.     '  but as a rule they all have at least
  612.     '  a 16 bit z buffer - or none at all
  613.     
  614.     Dim fenum As Direct3DEnumPixelFormats
  615.     Set fenum = d3d.GetEnumZBufferFormats(m_str3dDevGuid)
  616.     l = fenum.GetCount()
  617.     
  618.     '-  some cards dont support zbuffering so
  619.     '   we return success here because some cards can do
  620.     '   3d with out none
  621.     If l = 0 Then
  622.         DebugLog "card does not support Z buffering"
  623.         Exit Function
  624.         m_bNoZBuffer = True
  625.         AttatchZBuffer = True
  626.     End If
  627.     
  628.     '- loop through zbuffer formats and get the first 16 bit one
  629.     '  we find
  630.     For i = 1 To l
  631.         Call fenum.GetItem(i, ddsd2.ddpfPixelFormat)
  632.         If ddsd2.ddpfPixelFormat.lZBufferBitDepth = 16 Then Exit For
  633.     Next
  634.     
  635.     '- Get Z-buffer surface info
  636.     '  from back buffer
  637.     '  (w, h, bpp, video vs. system memory)
  638.     Call backSurface.GetSurfaceDesc(ddsd)
  639.                            
  640.     '- to describe a zbuffer surface we need the pixel format that
  641.     '  we already copied into ddsd2 above and the DDSCAPS_ZBUFFER
  642.     '  flag. m_memtype must be the same for the back buffer and the
  643.     '  the zbuffer (SYSTEM or VIDEO)
  644.     
  645.     ddsd2.lFlags = DDSD_CAPS Or _
  646.                 DDSD_WIDTH Or _
  647.                 DDSD_HEIGHT Or _
  648.                 DDSD_PIXELFORMAT
  649.     ddsd2.ddsCaps.lCaps = ddsd2.ddsCaps.lCaps Or DDSCAPS_ZBUFFER Or m_memtype
  650.     ddsd2.lWidth = ddsd.lWidth
  651.     ddsd2.lHeight = ddsd.lHeight
  652.     ddsd2.ddpfPixelFormat.lFlags = DDPF_ZBUFFER Or ddsd2.ddpfPixelFormat.lFlags
  653.     DebugLog "OK on get surface " + Str(ddsd.lWidth) + Str(ddsd.lHeight)
  654.     Set ZBuffer = dd.CreateSurface(ddsd2)
  655.     DebugLog "OK on create"
  656.     
  657.     '- Attach Z-buffer to rendering surface
  658.     Call backSurface.AddAttachedSurface(ZBuffer)
  659.     
  660.     DebugLog "OK on attach Z"
  661.     AttatchZBuffer = True
  662.     Exit Function
  663. errOut:
  664.     DebugLog "couldnt attach Z buffer"
  665.     AttatchZBuffer = False
  666. End Function
  667.  
  668.  
  669.  
  670.  
  671.  
  672. '-=========================================
  673. '- Clear
  674. '-=========================================
  675. Public Sub Clear()
  676.     On Local Error Resume Next
  677.     
  678.     Dim hr As Long
  679.     Dim r As RECT
  680.     Dim r2 As RECT
  681.     Dim arect(1) As D3DRECT
  682.         
  683.     
  684.     
  685.     '- TODO
  686.     '  can get much better performance
  687.     '  if I only blt update rectagles passed back
  688.     '  from d3d
  689.     '  It only crear the Zbuffer and
  690.     '  back buffer wear there are changes.
  691.     
  692.     '- setup rectangle to clear entire back buffer
  693.     '  and z buffer
  694.     arect(0).X1 = 0
  695.     arect(0).X2 = m_width
  696.     arect(0).Y1 = 0
  697.     arect(0).Y2 = m_height
  698.  
  699.  
  700.     '- Clear the ZBuffer (if there is one)
  701.     '  and clear the BackBuffer
  702.     Call d3dViewport.Clear(1, arect, D3DCLEAR_TARGET Or D3DCLEAR_ZBUFFER)
  703.     
  704. End Sub
  705.  
  706.  
  707.  
  708.  
  709.  
  710. '-=========================================
  711. ' CreateViewport
  712. '
  713. ' NOTE: There is a different setup if using
  714. '       TLverts vs other verts
  715. ' NOTE: In windowed mode we use the size of the
  716. '       window for the viewport
  717. '       In Full Screen.. the viewport is sized
  718. '       to current primary frontbuffer.
  719. '-=========================================
  720. '
  721. Public Function CreateViewport(width As Integer, height As Integer) As Boolean
  722.    
  723.     Dim hr As Integer
  724.     
  725.     On Local Error GoTo errOut
  726.  
  727.     '- Create the Viewport
  728.     Set d3dViewport = d3d.CreateViewport()
  729.         
  730.     '- Attach it to device
  731.     Call d3dDevice.AddViewport(d3dViewport)
  732.     
  733.     '- setup viewport data
  734.     Dim viewData As D3DVIEWPORT2
  735.         
  736.     viewData.lX = 0
  737.     viewData.lY = 0
  738.     viewData.lWidth = width
  739.     viewData.lHeight = height
  740.     viewData.minz = 0#
  741.     viewData.maxz = 1#
  742.     
  743.     '-If we plan to let the driver to tranforms
  744.     ' then our clipping info needs to be
  745.     ' set up like so
  746.     If (Not m_bTLVertices) Then
  747.         viewData.clipX = -1#
  748.         viewData.clipWidth = 2#
  749.         viewData.clipHeight = (height * 2# / width)
  750.         viewData.clipY = viewData.clipHeight / 2#
  751.     
  752.     '- if we plan to present coord in screen
  753.     '  space to the driver then our viewdata
  754.     '  needs to be setup as such
  755.     Else
  756.         viewData.clipX = 0
  757.         viewData.clipY = 0
  758.         viewData.clipWidth = width
  759.         viewData.clipHeight = height
  760.                
  761.     End If
  762.  
  763.     '- set the view data
  764.     Call d3dViewport.SetViewport2(viewData)
  765.         
  766.     '- make sure the Device knows which
  767.     '  viewport to use..
  768.     Call d3dDevice.SetCurrentViewport(d3dViewport)
  769.                 
  770.     CreateViewport = True
  771.     Exit Function
  772.     
  773. errOut:
  774.     CreateViewport = False
  775. End Function
  776.  
  777.  
  778. '-=========================================
  779. ' EnumDevices
  780. ' called to find the best 3ddevice
  781. '-=========================================
  782. Public Sub EnumDevices()
  783.     Dim devEnum As Direct3DEnumDevices
  784.     Dim devDescHW As D3DDEVICEDESC
  785.     Dim devDescSW As D3DDEVICEDESC
  786.     Dim info As DXDRIVERINFO
  787.     Dim i As Long
  788.     
  789.     
  790.     '- Get all the differnt 3d Devices (renderers) that
  791.     '  the current video card supports
  792.     '
  793.     Set devEnum = d3d.GetDevicesEnum()
  794.         
  795.     '- Assume HW is not supported
  796.     m_hwEnabled = False
  797.     
  798.     '- Loop through the list
  799.     '  CONSIDER - what if HW comes
  800.     For i = 1 To devEnum.GetCount()
  801.         m_hwEnabled = False
  802.         
  803.         '- Save the device guid and descirption
  804.         m_str3dDevGuid = devEnum.GetGuid(i)
  805.         m_str3dDevDesc = devEnum.GetName(i)
  806.         
  807.         '- Get the HW and Software Capabilities
  808.         devEnum.GetHWDesc i, devDescHW
  809.         devEnum.GetHELDesc i, devDescSW
  810.         
  811.         '- If we found a software device
  812.         '  the Softwarecaps color model will be non zero
  813.         If devDescSW.lColorModel = D3DCOLOR_RGB Then
  814.             m_str3dFallbackGuid = devEnum.GetGuid(i)
  815.             m_str3dFallbackDesc = devEnum.GetName(i)
  816.         End If
  817.         
  818.         '- If we are using System memory we have to use the software
  819.         '  device we found so exit out of the loop
  820.         If m_memtype = DDSCAPS_SYSTEMMEMORY And devDescHW.lColorModel = 0 Then
  821.             Exit For
  822.             
  823.         '- other wise exit out of the loop if our HW caps color model is non zero
  824.         '  meaning we found a HW 3d device
  825.         ElseIf m_memtype <> DDSCAPS_SYSTEMMEMORY And devDescHW.lColorModel <> 0 Then
  826.             m_hwEnabled = True
  827.             Exit For
  828.         End If
  829.         
  830.         
  831.     Next
  832.     
  833.     DebugLog "D3DIM " + m_str3dDevDesc
  834. End Sub
  835.  
  836.  
  837. '-=========================================
  838. ' Cleanup
  839. '
  840. ' release all surfaces and devices
  841. '-=========================================
  842.  
  843. Public Function Cleanup()
  844.     Set backSurface = Nothing
  845.     Set screenSurface = Nothing
  846.     
  847.     Set dd = Nothing
  848.     Set ZBuffer = Nothing
  849.     Set d3dViewport = Nothing
  850.     Set d3dDevice = Nothing
  851.     Set d3d = Nothing
  852.     
  853. End Function
  854.  
  855.  
  856.  
  857. '-=========================================
  858. ' SetInitDisplayMode
  859. '
  860. ' call before start to setup full screen
  861. '-=========================================
  862. Public Sub SetInitDisplayMode(w As Integer, h As Integer, bpp As Integer)
  863.     m_width = w
  864.     m_height = h
  865.     m_bpp = bpp
  866.     
  867.     dd.SetDisplayMode w, h, bpp, 0, 0
  868.  
  869. End Sub
  870.  
  871. '-=========================================
  872. ' EnableViewport
  873. '
  874. ' call before start to indicate if you want a default
  875. ' viewport setup for you - (default is true)
  876. '-=========================================
  877. Public Sub EnableViewport(b As Boolean)
  878.     m_bCreateViewport = b
  879. End Sub
  880.  
  881.  
  882. '-=========================================
  883. ' EnableViewport
  884. '
  885. ' call before start to indicate if you want a default
  886. ' Zbuffer setup for you - (default is true)
  887. '-=========================================
  888. Public Sub EnableZBuffer(b As Boolean)
  889.     m_bUseZBuffer = b
  890. End Sub
  891.  
  892.  
  893. '-=========================================
  894. ' SetDeviceGuid
  895. '
  896. ' call before start to indicate if a preference
  897. ' for a specific 3d device (rasterizer)
  898. '
  899. '-=========================================
  900. Public Sub SetDeviceGuid(strGuid As String)
  901.     m_strTry3dDevGuid = strGuid
  902. End Sub
  903.  
  904. '-=========================================
  905. ' SetSoftwareOnly
  906. '
  907. ' call before start to indicate that HW
  908. ' should not be used to render
  909. '
  910. Public Sub SetSoftwareOnly(b As Boolean)
  911.     m_bSoftwareOnly = b
  912. End Sub
  913.  
  914. '-=========================================
  915. ' Class_Initialize
  916. '
  917. '-=========================================
  918. Private Sub Class_Initialize()
  919.     
  920.     m_memtype = DDSCAPS_VIDEOMEMORY
  921.     m_bCreateViewport = True
  922.     m_width = 0
  923.     m_height = 0
  924.     m_bpp = 0
  925.     m_bUseZBuffer = True
  926. End Sub
  927.  
  928.  
  929. '-=========================================
  930. ' IsFullScreen
  931. '-=========================================
  932. Public Function IsFullScreen() As Boolean
  933.     IsFullScreen = m_bIsfullscreen
  934. End Function
  935.  
  936. '-=========================================
  937. ' m_strActiveDevGuid
  938. '-=========================================
  939. Public Function GetDeviceGuid() As String
  940.     GetDeviceGuid = m_strActiveDevGuid
  941. End Function
  942.  
  943. '-=========================================
  944. ' GetDeviceDesc
  945. '-=========================================
  946. Public Function GetDeviceDesc() As String
  947.     GetDeviceDesc = m_strActiveDevDesc
  948. End Function
  949.  
  950.  
  951. '-=========================================
  952. ' UseScreenCooredinateViewport
  953. '
  954. ' dont bother using
  955. '-=========================================
  956. Property Let UseScreenCooredinateViewport(b As Boolean)
  957.     m_bTLVertices = b
  958. End Property
  959.  
  960. '-=========================================
  961. ' UseScreenCooredinateViewport
  962. '
  963. ' dont bother using
  964. '-=========================================
  965. Property Get UseScreenCooredinateViewport() As Boolean
  966.     'default to false
  967.     UseScreenCooredinateViewport = m_bTLVertices
  968. End Property
  969.  
  970.  
  971.  
  972.  
  973.  
  974.  
  975.