home *** CD-ROM | disk | FTP | other *** search
/ Planet Source Code Jumbo …e CD Visual Basic 1 to 7 / 1_2002.ISO / Data / Zips / Membrane_E726374162002.psc / sphere7.frm < prev    next >
Encoding:
Text File  |  2002-04-14  |  2.4 KB  |  98 lines
  1. VERSION 5.00
  2. Begin VB.Form Form1 
  3.    BorderStyle     =   0  'None
  4.    ClientHeight    =   4815
  5.    ClientLeft      =   30
  6.    ClientTop       =   360
  7.    ClientWidth     =   6720
  8.    LinkTopic       =   "Form1"
  9.    MaxButton       =   0   'False
  10.    MinButton       =   0   'False
  11.    ScaleHeight     =   4815
  12.    ScaleWidth      =   6720
  13.    ShowInTaskbar   =   0   'False
  14. End
  15. Attribute VB_Name = "Form1"
  16. Attribute VB_GlobalNameSpace = False
  17. Attribute VB_Creatable = False
  18. Attribute VB_PredeclaredId = True
  19. Attribute VB_Exposed = False
  20.  
  21.  
  22.  
  23. Private Sub Form_Click()
  24.  g_state = -1
  25. End Sub
  26.  
  27. Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)
  28. If KeyCode = vbKeyUp Then vFrom.y = vFrom.y + 10
  29. If KeyCode = vbKeyDown Then vFrom.y = vFrom.y - 10
  30. If KeyCode = vbKeyRight Then vFrom.x = vFrom.x + 10
  31. If KeyCode = vbKeyLeft Then vFrom.x = vFrom.x - 10
  32. If KeyCode = vbKeyQ Then vFrom.z = vFrom.z + 10
  33. If KeyCode = vbKeyA Then vFrom.z = vFrom.z - 10
  34. If KeyCode = vbKeyEscape Then g_state = -10
  35. If KeyCode = vbKeySpace Then rotateCamera
  36.    'If g_state = 1 Then g_state = 2 Else g_state = 1
  37. 'End If
  38.  
  39. root.IdentityMatrix matrixView
  40. root.ViewMatrix matrixView, vFrom, vTo, vUp, 0#
  41. root_dd7_d3d7_Device.SetTransform D3DTRANSFORMSTATE_VIEW, matrixView
  42.  
  43. End Sub
  44.  
  45. Private Sub Form_Load()
  46. Dim nStartTime As Single
  47. Dim nEndTime As Single
  48. Dim frames As Long
  49.  
  50. 'defaultWidth = 1024
  51. 'defaultHeight = 768
  52. defaultWidth = 640
  53. defaultHeight = 480
  54. defaultBit = 16
  55. g_state = 1
  56.  
  57. Call Enumerate
  58. Call Initialize
  59. Call InitGraphics
  60.  
  61. Me.Show
  62. Me.Height = g_mode.lHeight * Screen.TwipsPerPixelY
  63. Me.Width = g_mode.lWidth * Screen.TwipsPerPixelX
  64. Do While g_state > 0
  65.     Do While g_state = 1
  66.         DoEvents
  67.         'fps code snippet
  68.         nStartTime = root.TickCount
  69.         frames = frames + 1
  70.         If (nStartTime - nEndTime) > 1000 Then
  71.             FPS = frames
  72.             frames = 0
  73.             nEndTime = root.TickCount
  74.         End If
  75.         Call render
  76.     Loop
  77.  
  78. Loop
  79.  
  80. Unload Me
  81.  
  82. End Sub
  83.  
  84. Private Sub Form_Unload(Cancel As Integer)
  85. root_dd7.SetCooperativeLevel Me.hWnd, DDSCL_NORMAL
  86. root_dd7.RestoreDisplayMode
  87.  
  88.  
  89. Set root_dd7_d3d7_Device = Nothing
  90. Set root_dd7_d3d7 = Nothing
  91. Set root_dd7_sZBuffer = Nothing
  92. Set root_dd7_d3d7 = Nothing
  93. Set root_dd7_sBack = Nothing
  94. Set root_dd7_sPrimary = Nothing
  95. Set root_dd7 = Nothing
  96. Set root = Nothing
  97. End Sub
  98.