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

  1. VERSION 5.00
  2. Object = "{08216199-47EA-11D3-9479-00AA006C473C}#2.0#0"; "RMCONTROL.OCX"
  3. Begin VB.Form RMFlyForm 
  4.    Caption         =   "VB RM Fly"
  5.    ClientHeight    =   4020
  6.    ClientLeft      =   60
  7.    ClientTop       =   345
  8.    ClientWidth     =   6285
  9.    Icon            =   "fly.frx":0000
  10.    LinkTopic       =   "Form1"
  11.    ScaleHeight     =   268
  12.    ScaleMode       =   3  'Pixel
  13.    ScaleWidth      =   419
  14.    StartUpPosition =   3  'Windows Default
  15.    Begin RMControl7.RMCanvas RMCanvas1 
  16.       Height          =   3948
  17.       Left            =   24
  18.       TabIndex        =   0
  19.       Top             =   24
  20.       Width           =   6192
  21.       _ExtentX        =   10927
  22.       _ExtentY        =   6959
  23.    End
  24. Attribute VB_Name = "RMFlyForm"
  25. Attribute VB_GlobalNameSpace = False
  26. Attribute VB_Creatable = False
  27. Attribute VB_PredeclaredId = True
  28. Attribute VB_Exposed = False
  29. Option Explicit
  30. '  The RMCanvas control now will let you use various properties after intialization
  31. '  Most relevant to Retained Mode users are
  32. '  RMCanvas1.D3DRM
  33. '           allows access to the root RM object
  34. '           it is from this object we can create new objects for exanple
  35. '           set f=RMCanvas1.D3DRM.createFrame(RMCanvas1.D3DRMFrameScene)
  36. '           set mb = RMCanvas1.D3DRM.createMeshBuilder()
  37. '    '
  38. '  About frames and meshbuilders
  39. '           which are visible to the ocx. A frame is a container for geometry
  40. '           a frame has variable position and orientation but geometry
  41. '           have fixed position and orientation. Meshbuilders hold geometry and
  42. '           can be afixed to frames so they can be placed and oriented.
  43. '           Other frames can be attached to frames (know as a scene graph)
  44. '           When a frame moves all frames and mesh builders attached to it
  45. '           move the same way. However the attached frames may move on their
  46. '           own relative to their parent. A good analogy is the solar system
  47. '           The sun is the root frame, attached to it is a child frame which holds
  48. '           the earth frame.
  49. '           Attached to the earth frame is geometry of a smaller sphere
  50. '           Also attached is another child frame for the moon which holds the moon
  51. '           geometry
  52. '           Imagine the sun frame rotating which makes the earth frame and everything
  53. '           in the earth frame rotate in an orbit around the sun.
  54. '           The earth frame can rotates inside the sun frame, rotating the earth sphere
  55. '           and also the moon frame.
  56. '           The moon frame doesnt have to rotate but just hold the smallest sphere to represent
  57. '           the moon. It will be rotated around the earth by the earths frame rotation
  58. '  RMCanvas1.SceneFrame
  59. '           this object is the parent for all objects (frame objects in particular)
  60. '           this is where we build our world
  61. '  RMCanvas1.CameraFrame
  62. '           this object is a child of the scene. Its position and orientation
  63. '           determine where the camera is at and what direction its looking toward
  64. '           By default the camera is -10 units back along the z axis looking toward
  65. '           0,0,0
  66. '  RMCanvas1.DirLightFrame
  67. '           there are 2 default lights that are setup for you. One is an ambient light
  68. '           which is omnidirectional and does not have location or direction. The other
  69. '           is a directional light. This frame is a child of the scene and holds the
  70. '           directional light. You can use functions like setPosition and lookAt to
  71. '           position and orient the light. By default the light is at 5,5,5 looking
  72. '           toward 0,0,0
  73. '  RMCanvas1.DirLight
  74. '           This is the light object placed in the FrameDirLight frame
  75. '           you can use the setColorRGB method to change the lights color
  76. '  RMCanvas1.AmbientLight
  77. '           This determine how much outdoor type light is in the scene.
  78. '           use the setColorRGB to set the color and intensity of the light
  79. '           be aware the white will white out our scene so use low levels
  80. '           of grey
  81. ' RMCanvas1.Viewport
  82. '           The viewport object describes how the camera works
  83. '           the setField method is used to determine how narrow an
  84. '           area you are looking at.
  85. '           The setFront and setBack methods are used to define how far
  86. '           away you would like to see to and how close an object you can see
  87. '           picking objects is also done through the viewport interface
  88. '  RMCanvas1.Device
  89. '           The device object can control this such as quality
  90. '           SetQuality can be use to change your scene from wire frame
  91. '           to flat shaded to smooth shaded (gauraud)
  92. '  RMCanvas1.SceneSpeed
  93. '           (in units per second) can be set to adjust how rotation
  94. '           and velocity effect an object. The default is 30 units/second
  95. '  Other properties that let you draw ontop of the 3d scence
  96. '  are also available (DDBackSurface for example). Use the
  97. Dim m_planeFrame As Direct3DRMFrame3
  98. Dim m_chaseFrame As Direct3DRMFrame3
  99. Dim m_flightAnim As Direct3DRMAnimation2
  100. Dim m_time As Single
  101. Dim m_bRetDown As Boolean
  102. Dim m_bAltDown As Boolean
  103. Dim m_bRunning As Boolean
  104. Private Sub Form_Load()
  105.     Static b As Boolean
  106.     If b = True Then End
  107.     b = True
  108.     Me.Show
  109.     DoEvents
  110.     init
  111.     End
  112. End Sub
  113. '- Add Handler to resize the ActiveX control when form resizes
  114. Private Sub Form_Resize()
  115.     RMCanvas1.Width = Me.ScaleWidth
  116.     RMCanvas1.Height = Me.ScaleHeight
  117. End Sub
  118. Sub init()
  119.     Dim b As Boolean
  120.     Dim sFile As String
  121.         
  122.     '  We want to run a windowed application
  123.     '
  124.     '  by default StartWindowed will try and find 3d hardware
  125.     '  on your primary display. If it doesnt find it,
  126.     '  it will default to using the slower sofware
  127.     '  RGB rasterizer
  128.     '
  129.     b = RMCanvas1.StartWindowed
  130.     If b = False Then
  131.         MsgBox "problem starting DirectX RM"
  132.         End
  133.     End If
  134.     InitScene
  135.     RenderLoop
  136. End Sub
  137. Sub InitScene()
  138.     FindMediaDir "land4.x"
  139.             
  140.     CreateLandScape
  141.     CreatePlaneAndChaseFrame
  142.     CreatePathAnimation
  143. End Sub
  144. Sub CreateLandScape()
  145.     Dim mbLand As Direct3DRMMeshBuilder3
  146.     Dim fLand As Direct3DRMFrame3
  147.     Dim box As D3DRMBOX
  148.     Dim i As Integer, j As Integer
  149.     '- Create a Frame object which is parented to the scene
  150.     Set fLand = RMCanvas1.D3DRM.CreateFrame(RMCanvas1.SceneFrame)
  151.         
  152.     '- Create an empty meshbuilder object
  153.     Set mbLand = RMCanvas1.D3DRM.CreateMeshBuilder()
  154.                 
  155.     '- Load land geometry from a file into the meshbuilder and attach it to the frame
  156.     mbLand.LoadFromFile "land4.x", 0, 0, Nothing, Nothing
  157.     fLand.AddVisual mbLand
  158.     '- scale the land to be larger and get its extent
  159.     mbLand.ScaleMesh 10, 8, 10
  160.     mbLand.GetBox box
  161.     Dim range As Single
  162.         
  163.     range = box.Max.y - box.Min.y
  164.         
  165.     RMCanvas1.SceneFrame.SetSceneBackground &H6060E0
  166.     RMCanvas1.AmbientLight.SetColorRGB 0.36, 0.36, 0.36
  167.     'color faces acording to height
  168.     Dim vert As D3DVECTOR, norm As D3DVECTOR, y As Single
  169.     For i = 0 To mbLand.GetFaceCount() - 1
  170.         y = box.Min.y
  171.         For j = 0 To mbLand.GetFace(i).GetVertexCount() - 1
  172.             mbLand.GetFace(i).GetVertex j, vert, norm
  173.             If vert.y > y Then y = vert.y
  174.         Next
  175.         If (y - box.Min.y) / range < 0.05 Then
  176.             Call mbLand.GetFace(i).SetColorRGB((y - box.Min.y) / range, 0.6, 1 - (y - box.Min.y) / range)
  177.         Else
  178.             Call mbLand.GetFace(i).SetColorRGB(0.2 + (y - box.Min.y) / range, 1 - (y - box.Min.y) / range, 0.5)
  179.         End If
  180.     Next
  181.                        
  182. End Sub
  183. Sub CreatePlaneAndChaseFrame()
  184.     Dim mbPlane As Direct3DRMMeshBuilder3
  185.     Set mbPlane = RMCanvas1.D3DRM.CreateMeshBuilder()
  186.     mbPlane.LoadFromFile "dropship.x", 0, 0, Nothing, Nothing
  187.     mbPlane.ScaleMesh 0.015, 0.008, 0.015
  188.     mbPlane.SetColorRGB 0.8, 0.8, 0.8
  189.     Set m_planeFrame = RMCanvas1.D3DRM.CreateFrame(RMCanvas1.SceneFrame)
  190.     m_planeFrame.AddVisual mbPlane
  191.     Set m_chaseFrame = RMCanvas1.D3DRM.CreateFrame(RMCanvas1.SceneFrame)
  192.     Dim verts(1000) As D3DRMVERTEX
  193. End Sub
  194. Sub CreatePathAnimation()
  195.     Dim pathdata
  196.     Dim x As Single, y As Single, z As Single, i As Integer
  197.     pathdata = Array( _
  198.             -8, 3, -12, _
  199.             -4, 2, -8, _
  200.             -2, 0, -4, _
  201.              9, -1, 7, _
  202.              4, 6, 10, _
  203.             -4, 5, 9, _
  204.              5.5, 3.5, -6.5, _
  205.              2, 5, -10, _
  206.              0, 4, -15, _
  207.             -5, 4, -15, _
  208.             -8, 3, -12)
  209.                  
  210.     Set m_flightAnim = RMCanvas1.D3DRM.CreateAnimation()
  211.     m_flightAnim.SetOptions D3DRMANIMATION_CLOSED Or D3DRMANIMATION_SPLINEPOSITION Or D3DRMANIMATION_POSITION
  212.     Dim key As D3DRMANIMATIONKEY
  213.     For i = 0 To 10
  214.         x = pathdata(i * 3)
  215.         y = pathdata(i * 3 + 1)
  216.         z = pathdata(i * 3 + 2)
  217.         'm_flightAnim.AddPositionKey i, x, y, z
  218.         
  219.         key.dvX = x
  220.         key.dvY = y
  221.         key.dvZ = z
  222.         key.lKeyType = 3
  223.         key.dvTime = i
  224.         m_flightAnim.AddKey key
  225.         
  226.     Next
  227. End Sub
  228. Sub UpdatePlaneAndCamera(delta As Single)
  229.     Dim dir As D3DVECTOR
  230.     Dim up As D3DVECTOR
  231.     Dim dirCam As D3DVECTOR
  232.     Dim upCam As D3DVECTOR
  233.     Dim a_bit As Single
  234.     RMCanvas1.SceneSpeed = 1
  235.     m_time = m_time + delta
  236.     'set up camera frame position
  237.     m_flightAnim.SetFrame RMCanvas1.CameraFrame
  238.     m_flightAnim.SetTime m_time + 0
  239.     'set up plane frame position
  240.     m_flightAnim.SetFrame m_planeFrame
  241.     m_flightAnim.SetTime m_time + 0.5
  242.     'set up chase frame
  243.     m_flightAnim.SetFrame m_chaseFrame
  244.     m_flightAnim.SetTime m_time + 1
  245.     'orient the camera to look at the plane
  246.     RMCanvas1.CameraFrame.LookAt m_planeFrame, Nothing, D3DRMCONSTRAIN_Z
  247.     'orient the plane to look at the chase frame
  248.     m_planeFrame.LookAt m_chaseFrame, Nothing, D3DRMCONSTRAIN_Y
  249.             
  250.                 
  251.     'figure out the bank for the plane
  252.     RMCanvas1.CameraFrame.GetOrientation Nothing, dirCam, upCam
  253.     m_planeFrame.GetOrientation Nothing, dir, up
  254.         
  255.     up.x = dir.x - dirCam.x
  256.     up.y = dir.y - dirCam.y + 1#
  257.     up.z = dir.z - dirCam.z
  258.         
  259.     m_planeFrame.SetOrientation Nothing, dir.x, dir.y, dir.z, up.x, up.y, up.z
  260. End Sub
  261. Private Sub Form_Unload(Cancel As Integer)
  262.     m_bRunning = False
  263. End Sub
  264. Sub FindMediaDir(sFile As String)
  265.     On Local Error Resume Next
  266.     If Mid$(App.Path, 2, 1) = ":" Then
  267.         ChDrive Mid$(App.Path, 1, 1)
  268.     End If
  269.     ChDir App.Path
  270.     If dir$(sFile) = "" Then
  271.         ChDir "..\media"
  272.     End If
  273.     If dir$(sFile) = "" Then
  274.         ChDir "..\..\media"
  275.     End If
  276. End Sub
  277. Sub RenderLoop()
  278.     '- RenderLoop
  279.     '  a tight infinite loop will keep the frame right high
  280.     '  but hog the CPU .. for OCX design and non graphics centric applications
  281.     '  use a Timer to update the scene, allowing more of the CPU open
  282.     '  to other tasks
  283.     '  Note we use the unload event to break out of this loop with an end
  284.     '
  285.     m_bRunning = True
  286.     Do While m_bRunning
  287.         
  288.         '- We update the scene.
  289.         RMCanvas1.Update
  290.         
  291.         '- Doevents is necessary to allow events (such as key down, click)
  292.         '  to be processed
  293.         DoEvents
  294.         
  295.     Loop
  296. End Sub
  297. Private Sub RMCanvas1_SceneMove(delta As Single)
  298.     UpdatePlaneAndCamera delta
  299. End Sub
  300.