home *** CD-ROM | disk | FTP | other *** search
/ Planet Source Code Jumbo …e CD Visual Basic 1 to 7 / 1_2002.ISO / Data / Zips / CODE_UPLOAD39693132000.psc / Form1.frm (.txt) next >
Encoding:
Visual Basic Form  |  2000-03-13  |  6.4 KB  |  180 lines
  1. VERSION 5.00
  2. Object = "{08216199-47EA-11D3-9479-00AA006C473C}#2.1#0"; "RMCONTROL.OCX"
  3. Begin VB.Form Form1 
  4.    BackColor       =   &H00000000&
  5.    BorderStyle     =   0  'None
  6.    Caption         =   "Form1"
  7.    ClientHeight    =   3195
  8.    ClientLeft      =   0
  9.    ClientTop       =   0
  10.    ClientWidth     =   4755
  11.    LinkTopic       =   "Form1"
  12.    ScaleHeight     =   3195
  13.    ScaleWidth      =   4755
  14.    ShowInTaskbar   =   0   'False
  15.    StartUpPosition =   3  'Windows Default
  16.    WindowState     =   2  'Maximized
  17.    Begin RMControl7.RMCanvas RMCanvas 
  18.       Height          =   3255
  19.       Left            =   0
  20.       TabIndex        =   0
  21.       Top             =   0
  22.       Width           =   4695
  23.       _ExtentX        =   8281
  24.       _ExtentY        =   5741
  25.    End
  26. Attribute VB_Name = "Form1"
  27. Attribute VB_GlobalNameSpace = False
  28. Attribute VB_Creatable = False
  29. Attribute VB_PredeclaredId = True
  30. Attribute VB_Exposed = False
  31. '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
  32. 'RM Control Sample v1.0
  33. 'Author: Dustin Davis
  34. 'VB-Live.com
  35. 'I wrote this to show you how EASY it is to use the RM control
  36. 'and that you can make really cool stuff with this.
  37. 'Enjoy!
  38. 'I used 3D studio max R3 to create the scene and then converted
  39. 'the .3ds files to .x files using the conv3ds.exe program that
  40. 'comes with DirectX SDK
  41. 'mssdk\bin\dxutils\xfiles
  42. 'NOTE: I turned this into a screen saver, so there are
  43. 'Screensaver forms and code for this to be a screensaver
  44. 'Just ignor it.
  45. ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
  46. 'Declare our main variables
  47. Dim m_Rm As Direct3DRM3
  48. Dim g_Dx As New DirectX7
  49. 'declare our frame animation variables
  50. Dim m_NameAnimation As Direct3DRMAnimationSet2
  51. Dim m_CircleAnimation As Direct3DRMAnimationSet2
  52. Dim m_Circle2Animation As Direct3DRMAnimationSet2
  53. 'declare our frame variables
  54. Dim m_Circle As Direct3DRMFrame3
  55. Dim m_rootFrame As Direct3DRMFrame3
  56. Dim m_NameFrame As Direct3DRMFrame3
  57. Dim m_Circle2 As Direct3DRMFrame3
  58. 'declare our light variables
  59. Dim m_light As Direct3DRMLight
  60. Dim c_light As Direct3DRMLight
  61. Dim c_light2 As Direct3DRMLight
  62. 'declare loop variables
  63. Dim KeepGoing As Boolean
  64. Public Sub Init()
  65. 'This is where the magic happens!
  66. 'Tell the rm control to start windowed. I dont want to deal with
  67. 'Direct Draw to change the screen modes to full right now
  68. b = RMCanvas.StartWindowed
  69. 'Check if it can be loaded
  70. If b = False Then
  71.     MsgBox "Cant start 3D window"
  72.     End
  73. End If
  74. 'Set the scene background color
  75. RMCanvas.SceneFrame.SetSceneBackgroundRGB 0, 0, 0
  76. 'Make the RM control
  77. Set m_Rm = g_Dx.Direct3DRMCreate
  78. 'Set the frames
  79. Set m_rootFrame = m_Rm.CreateFrame(Nothing)
  80. Set m_NameFrame = m_Rm.CreateFrame(m_rootFrame)
  81. Set m_Circle = m_Rm.CreateFrame(m_rootFrame)
  82. Set m_Circle2 = m_Rm.CreateFrame(m_rootFrame)
  83. 'Create the frames
  84. Set m_NameFrame = RMCanvas.D3DRM.CreateFrame(RMCanvas.SceneFrame)
  85. Set m_Circle = RMCanvas.D3DRM.CreateFrame(RMCanvas.SceneFrame)
  86. Set m_Circle2 = RMCanvas.D3DRM.CreateFrame(RMCanvas.SceneFrame)
  87. 'create animation frames
  88. Set m_NameAnimation = RMCanvas.D3DRM.CreateAnimationSet()
  89. Set m_CircleAnimation = RMCanvas.D3DRM.CreateAnimationSet()
  90. Set m_Circle2Animation = RMCanvas.D3DRM.CreateAnimationSet()
  91. 'Set the animation frame properties
  92. m_NameAnimation.LoadFromFile "d.x", 0, 0, Nothing, Nothing, m_NameFrame
  93. m_CircleAnimation.LoadFromFile "n4u.x", 0, 0, Nothing, Nothing, m_Circle
  94. m_Circle2Animation.LoadFromFile "n4u.x", 1, 0, Nothing, Nothing, m_Circle2
  95. 'Set the orientation of the frames       -1 = reverse
  96. m_NameFrame.SetOrientation Nothing, 0, 0, 1, 0, 1, 0
  97. m_Circle.SetOrientation Nothing, 0, 0, 1, 0, 1, 0
  98. m_Circle2.SetOrientation Nothing, 0, 0, 1, 0, 1, 0
  99. 'Add scale to the scenes
  100. m_NameFrame.AddScale D3DRMCOMBINE_AFTER, 0.3, 0.3, 0.3
  101. m_Circle.AddScale D3DRMCOMBINE_AFTER, 0.3, 0.3, 0.3
  102. m_Circle2.AddScale D3DRMCOMBINE_AFTER, 0.3, 0.3, 0.3
  103. 'Set position and viewport of camera
  104. RMCanvas.CameraFrame.SetPosition Nothing, x, Y, z
  105. RMCanvas.Viewport.SetBack 1000
  106. 'Create lights
  107. Set m_light = m_Rm.CreateLightRGB(D3DRMLIGHT_AMBIENT, 0, 0, 0.3)
  108. Set c_light = m_Rm.CreateLightRGB(D3DRMLIGHT_DIRECTIONAL, 0, 0.4, 0)
  109. Set c_light2 = m_Rm.CreateLightRGB(D3DRMLIGHT_DIRECTIONAL, 0.4, 0, 0)
  110. 'Attatch lights to frames
  111. m_NameFrame.AddLight m_light
  112. m_Circle.AddLight c_light
  113. m_Circle2.AddLight c_light2
  114. 'Set the position of the frames
  115. m_Circle.SetPosition m_rootFrame, 0, 8, 60
  116. m_Circle2.SetPosition m_rootFrame, 10, 0, 60
  117. m_NameFrame.SetPosition m_rootFrame, 0, 5, 120
  118. 'Set scene speed, this is for animation, but since we
  119. 'only rotate the frames, this isnt needed
  120. RMCanvas.SceneSpeed = 30
  121. 'Set the rotation of the frames, this controls how they spin
  122. 'and how fast                    X  Y  Z  Speed
  123. m_NameFrame.SetRotation Nothing, 0, 1, 0, 0.02
  124. m_Circle.SetRotation Nothing, 0, -1, 0, 0.3
  125. m_Circle2.SetRotation Nothing, 0, 1, 0, 0.2
  126. 'Start the loop
  127. Do Until KeepGoing = False
  128.         'Update the scene
  129.         RMCanvas.Update
  130.         DoEvents
  131. Exit Sub
  132. End Sub
  133. Private Sub Form_Activate()
  134. 'for screen saver purposes, really not needed
  135. If App.PrevInstance = True Then Unload Me
  136. AlwaysOnTop Me, True
  137. Static b As Boolean
  138.     KeepGoing = True
  139.     If b = True Then End
  140.     b = True
  141.     Init
  142.     Me.Show
  143.     End
  144. End Sub
  145. Private Sub Form_KeyPress(KeyAscii As Integer)
  146. End Sub
  147. Private Sub Form_Resize()
  148. On Local Error Resume Next
  149.     RMCanvas.Width = Me.ScaleWidth
  150.     RMCanvas.Height = Me.ScaleHeight
  151.     RMCanvas.Viewport.SetBack 1000
  152. End Sub
  153. Private Sub Form_Unload(Cancel As Integer)
  154. m_running = False
  155. KeepGoing = False
  156. End Sub
  157. Private Sub RMCanvas_KeyPress(KeyAscii As Integer)
  158. End Sub
  159. Private Sub RMCanvas_SceneMove(delta As Single)
  160. m_time = m_time + delta
  161. m_NameAnimation.SetTime m_time
  162. End Sub
  163. Sub AlwaysOnTop(FrmID As Form, OnTop As Integer)
  164. 'This function came from planet-source-code.com!
  165.     ' This function uses an argument to dete
  166.     '     rmine whether
  167.     ' to make the specified form always on t
  168.     '     op or not
  169.     Const SWP_NOMOVE = 2
  170.     Const SWP_NOSIZE = 1
  171.     Const FLAGS = SWP_NOMOVE Or SWP_NOSIZE
  172.     Const HWND_TOPMOST = -1
  173.     Const HWND_NOTOPMOST = -2
  174.     If OnTop Then
  175.         OnTop = SetWindowPos(Me.hWnd, HWND_TOPMOST, 0, 0, 0, 0, FLAGS)
  176.     Else
  177.         OnTop = SetWindowPos(Me.hWnd, HWND_TOPMOST, 0, 0, 0, 0, FLAGS)
  178.     End If
  179. End Sub
  180.