home *** CD-ROM | disk | FTP | other *** search
/ Microsoft DirectX SDK 7.0 / Dx7.bin / DXF / samples / multimedia / vbsamples / d3drm / src / teapot / mainfrm.frm (.txt) < prev    next >
Encoding:
Visual Basic Form  |  1999-08-04  |  6.1 KB  |  175 lines

  1. VERSION 5.00
  2. Begin VB.Form MainFrm 
  3.    BorderStyle     =   0  'None
  4.    Caption         =   "Teapot Sample"
  5.    ClientHeight    =   6165
  6.    ClientLeft      =   0
  7.    ClientTop       =   0
  8.    ClientWidth     =   6795
  9.    Icon            =   "MainFrm.frx":0000
  10.    LinkTopic       =   "Form1"
  11.    ScaleHeight     =   6165
  12.    ScaleWidth      =   6795
  13.    ShowInTaskbar   =   1  'True
  14.    StartUpPosition =   3  'Windows Default
  15. Attribute VB_Name = "MainFrm"
  16. Attribute VB_GlobalNameSpace = False
  17. Attribute VB_Creatable = False
  18. Attribute VB_PredeclaredId = True
  19. Attribute VB_Exposed = False
  20. ' Sample showing how to use the shadow object as well as going full screen in RM
  21. Option Explicit
  22. Dim DX As New DirectX7
  23. Dim DD As DirectDraw4
  24. Dim ddClipper As DirectDrawClipper
  25. Dim RM As Direct3DRM3
  26. Dim SurfPrimary As DirectDrawSurface4
  27. Dim SurfBack As DirectDrawSurface4
  28. Dim DDSDPrimary As DDSURFACEDESC2
  29. Dim DDCapsBack As DDSCAPS2
  30. Dim rmDevice As Direct3DRMDevice3
  31. Dim rmViewport As Direct3DRMViewport2
  32. Dim rootFrame As Direct3DRMFrame3
  33. Dim lightFrame As Direct3DRMFrame3
  34. Dim cameraFrame As Direct3DRMFrame3
  35. Dim objectFrame As Direct3DRMFrame3
  36. Dim light As Direct3DRMLight
  37. Dim shadow_light As Direct3DRMLight
  38. Dim meshBuilder As Direct3DRMMeshBuilder3
  39. Dim object As Direct3DRMMeshBuilder3
  40. Dim shadow As Direct3DRMShadow2
  41. Dim bRunning As Boolean
  42. Dim CurModeActiveStatus As Boolean
  43. Dim bRestore As Boolean
  44. Sub InitDX()
  45.     ' create the ddraw object and set the cooperative level
  46.     Set DD = DX.DirectDraw4Create("")
  47.     MainFrm.Show
  48.     DD.SetCooperativeLevel MainFrm.hWnd, DDSCL_FULLSCREEN Or DDSCL_EXCLUSIVE
  49.     ' this will be full-screen, so set the display mode
  50.     DD.SetDisplayMode 640, 480, 16, 0, DDSDM_DEFAULT
  51.     ' create the primary surface
  52.     DDSDPrimary.lFlags = DDSD_CAPS Or DDSD_BACKBUFFERCOUNT
  53.     DDSDPrimary.ddsCaps.lCaps = DDSCAPS_PRIMARYSURFACE Or DDSCAPS_3DDEVICE Or DDSCAPS_COMPLEX Or DDSCAPS_FLIP
  54.     DDSDPrimary.lBackBufferCount = 1
  55.     Set SurfPrimary = DD.CreateSurface(DDSDPrimary)
  56.            
  57.     ' get the back buffer
  58.     DDCapsBack.lCaps = DDSCAPS_BACKBUFFER
  59.     Set SurfBack = SurfPrimary.GetAttachedSurface(DDCapsBack)
  60.     ' Create the Retained Mode object
  61.     Set RM = DX.Direct3DRMCreate()
  62.     ' Now, create the device from the full screen DD surface
  63.     Set rmDevice = RM.CreateDeviceFromSurface("IID_IDirect3DRGBDevice", DD, SurfBack, D3DRMDEVICE_DEFAULT)
  64.     rmDevice.SetBufferCount 2
  65.     rmDevice.SetQuality D3DRMLIGHT_ON Or D3DRMFILL_SOLID Or D3DRMRENDER_GOURAUD
  66.     rmDevice.SetTextureQuality D3DRMTEXTURE_NEAREST
  67.     rmDevice.SetRenderMode D3DRMRENDERMODE_BLENDEDTRANSPARENCY
  68. End Sub
  69. Sub InitScene(sMesh As String)
  70.     ' Create the scene frames
  71.     Set rootFrame = RM.CreateFrame(Nothing)
  72.     Set cameraFrame = RM.CreateFrame(rootFrame)
  73.     Set lightFrame = RM.CreateFrame(rootFrame)
  74.     Set objectFrame = RM.CreateFrame(rootFrame)
  75.     ' Set the background color
  76.     rootFrame.SetSceneBackgroundRGB 0, 255, 255
  77.     ' create & position lights and the viewport
  78.     cameraFrame.SetPosition Nothing, 0, 0, -10
  79.     Set rmViewport = RM.CreateViewport(rmDevice, cameraFrame, 0, 0, 640, 480)
  80.     lightFrame.SetPosition Nothing, 2, 5, -10
  81.     Set shadow_light = RM.CreateLightRGB(D3DRMLIGHT_POINT, 0.9, 0.8, 0.7)
  82.     lightFrame.AddLight shadow_light
  83.     Set light = RM.CreateLightRGB(D3DRMLIGHT_AMBIENT, 0.1, 0.1, 0.1)
  84.     rootFrame.AddLight light
  85.     ' create the mesh and load the teapot x file
  86.     Set meshBuilder = RM.CreateMeshBuilder()
  87.     meshBuilder.LoadFromFile sMesh, 0, 0, Nothing, Nothing
  88.     ' make the shadow and enable alpha
  89.     Set shadow = RM.CreateShadow(meshBuilder, shadow_light, 0, -3, 0, 0, 1, 0)
  90.     shadow.SetOptions D3DRMSHADOW_TRUEALPHA
  91.     ' add the visuals
  92.     objectFrame.AddVisual meshBuilder
  93.     objectFrame.AddVisual shadow
  94.     'Have the object rotating
  95.     objectFrame.SetRotation Nothing, 3, 3, 1, 0.45
  96. End Sub
  97. Sub RenderLoop()
  98.     Dim t1 As Long
  99.     Dim t2 As Long
  100.     Dim delta As Single
  101.     On Local Error Resume Next
  102.     bRunning = True
  103.     t1 = DX.TickCount()
  104.     Do While bRunning = True
  105.         DoEvents
  106.         
  107.         ' this will keep us from trying to blt in case we lose the surfaces (alt-tab)
  108.         bRestore = False
  109.         Do Until ExModeActive
  110.             DoEvents
  111.             bRestore = True
  112.         Loop
  113.         ' if we lost and got back the surfaces, then restore them
  114.         DoEvents
  115.         If bRestore Then
  116.             bRestore = False
  117.             DD.RestoreAllSurfaces
  118.         End If
  119.         
  120.         
  121.         rootFrame.Move 0.5
  122.         rmViewport.Clear D3DRMCLEAR_TARGET Or D3DRMCLEAR_ZBUFFER ' clear the viewport
  123.         rmDevice.Update   'blt the image to the screen
  124.         rmViewport.Render rootFrame 'render to the device
  125.         Call SurfBack.DrawText(10, 10, "D3DRM Full Screen with Alpha Shadow", False)
  126.         Call SurfBack.DrawText(10, 30, "Click screen or hit ESC to exit", False)
  127.         SurfPrimary.Flip Nothing, DDFLIP_WAIT
  128.     Loop
  129. End Sub
  130. Function ExModeActive() As Boolean
  131.     Dim TestCoopRes As Long
  132.     TestCoopRes = DD.TestCooperativeLevel
  133.     If (TestCoopRes = DD_OK) Then
  134.         ExModeActive = True
  135.     Else
  136.         ExModeActive = False
  137.     End If
  138. End Function
  139. Sub FindMediaDir(sFile As String)
  140.     On Local Error Resume Next
  141.     If Mid$(App.Path, 2, 1) = ":" Then
  142.         ChDrive Mid$(App.Path, 1, 1)
  143.     End If
  144.     ChDir App.Path
  145.     If Dir$(sFile) = "" Then
  146.         ChDir "..\media"
  147.     End If
  148.     If Dir$(sFile) = "" Then
  149.         ChDir "..\..\media"
  150.     End If
  151. End Sub
  152. Private Sub Form_Load()
  153.     Show
  154.     DoEvents
  155.     InitDX
  156.     FindMediaDir "teapot.x"
  157.     InitScene "teapot.x"
  158.     RenderLoop
  159.     End
  160. End Sub
  161. Sub EndIT()
  162.     bRunning = False
  163.     Call DD.RestoreDisplayMode
  164.     Call DD.SetCooperativeLevel(Me.hWnd, DDSCL_NORMAL)
  165.     End
  166. End Sub
  167. Private Sub Form_KeyPress(KeyAscii As Integer)
  168.     If KeyAscii = 27 Then ' if ESC is pressed
  169.         EndIT
  170.     End If
  171. End Sub
  172. Private Sub Form_Click()
  173.     EndIT
  174. End Sub
  175.