home *** CD-ROM | disk | FTP | other *** search
/ Planet Source Code Jumbo …e CD Visual Basic 1 to 7 / 4_2005-2006.ISO / data / Zips / First_pers2061124192007.psc / FPS2 / frmMain.frm next >
Text File  |  2005-12-15  |  4KB  |  128 lines
  1. VERSION 5.00
  2. Begin VB.Form frmMain 
  3.    Caption         =   "Form1"
  4.    ClientHeight    =   8490
  5.    ClientLeft      =   165
  6.    ClientTop       =   555
  7.    ClientWidth     =   8880
  8.    LinkTopic       =   "Form1"
  9.    ScaleHeight     =   566
  10.    ScaleMode       =   3  'Pixel
  11.    ScaleWidth      =   592
  12.    StartUpPosition =   3  'Windows Default
  13. End
  14. Attribute VB_Name = "frmMain"
  15. Attribute VB_GlobalNameSpace = False
  16. Attribute VB_Creatable = False
  17. Attribute VB_PredeclaredId = True
  18. Attribute VB_Exposed = False
  19. '#########################################################
  20. '#                                                       #
  21. '#      A First Person Shooting game (Incomplete)        #
  22. '#                                                       #
  23. '#      By: Aayush Kaistha                               #
  24. '#      Place: UIET, Panjab University Chandigarh, India #
  25. '#      Contact: aayushkaistha@gmail.com                 #
  26. '#                                                       #
  27. '#########################################################
  28.  
  29. Option Explicit
  30. Implements DirectXEvent8 'for an event based system we need a callback function
  31.  
  32. Private Sub DirectXEvent8_DXCallback(ByVal eventid As Long)
  33. Dim tmpAng As Single
  34.  
  35. On Error Resume Next
  36. If Player.Dead Then Exit Sub
  37.  
  38. If Not (eventid = hEvent) Then Exit Sub
  39.  
  40. Dim DevData(1 To 10) As DIDEVICEOBJECTDATA 'storage for the event data
  41. Dim nEvents As Long 'how many events have just happened (usually 1)
  42. Dim i As Long 'looping variables
  43.         
  44. '1. retrieve the data from the device.
  45. nEvents = DIDevice.GetDeviceData(DevData, DIGDD_DEFAULT)
  46.         
  47. '2. loop through all the events
  48. For i = 1 To nEvents
  49.     Select Case DevData(i).lOfs
  50.         Case DIMOFS_X
  51.             'the mouse has moved along the X Axis
  52.             tmpAng = DevData(i).lData * 0.005
  53.             Player.Rotation = Player.Rotation + tmpAng
  54.             If Player.Rotation < 0 Then Player.Rotation = 2 * PI
  55.             If Player.Rotation > 2 * PI Then Player.Rotation = 0
  56.  
  57.         Case DIMOFS_Y
  58.             'the mouse has moved along the Y axis
  59.             CamPitch = CamPitch + (DevData(i).lData * 0.005)
  60.             If CamPitch < -PI / 4 Then CamPitch = -PI / 4
  61.             If CamPitch > PI / 4 Then CamPitch = PI / 4
  62.              
  63.         Case DIMOFS_BUTTON0
  64.             'the first (left) button has been pressed
  65.             If DevData(i).lData <> 0 Then
  66.                 Fire = True
  67.                 sndShoot.Stop
  68.                 sndShoot.SetCurrentPosition 0
  69.                 sndShoot.Play DSBPLAY_DEFAULT
  70.                 FireTimer = GetTickCount
  71.             End If
  72.             
  73.         Case DIMOFS_BUTTON1
  74.             'the second (right) button has been pressed
  75.             Dim Ang As Single
  76.             If DevData(i).lData <> 0 Then
  77.                 Zoom = True
  78.                 Ang = PI / 10
  79.             Else
  80.                 Zoom = False
  81.                 Ang = PI / 3
  82.             End If
  83.             D3DXMatrixPerspectiveFovLH matProj, Ang, 1, 1, 10000
  84.             D3DDevice.SetTransform D3DTS_PROJECTION, matProj
  85.  
  86.         Case DIMOFS_BUTTON2
  87.             'the third (middle usually) button has been pressed
  88.     End Select
  89. Next i
  90.     
  91. DoEvents 'let windows catch up on things...
  92.  
  93. End Sub
  94.  
  95. Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)
  96.  
  97. If KeyCode = vbKeyUp Then UpKey = True
  98. If KeyCode = vbKeyDown Then DownKey = True
  99. If KeyCode = vbKeyLeft Then LeftKey = True
  100. If KeyCode = vbKeyRight Then RightKey = True
  101.  
  102. If KeyCode = vbKeyS Then SKey = True
  103. If KeyCode = vbKeyW Then WKey = True
  104.  
  105. End Sub
  106.  
  107. Private Sub Form_KeyUp(KeyCode As Integer, Shift As Integer)
  108.  
  109. If KeyCode = vbKeyUp Then UpKey = False
  110. If KeyCode = vbKeyDown Then DownKey = False
  111. If KeyCode = vbKeyLeft Then LeftKey = False
  112. If KeyCode = vbKeyRight Then RightKey = False
  113.  
  114. If KeyCode = vbKeyEscape Then bRunning = False
  115.  
  116. If KeyCode = vbKeyS Then SKey = False
  117. If KeyCode = vbKeyW Then WKey = False
  118.  
  119. End Sub
  120.  
  121. Private Sub Form_Unload(Cancel As Integer)
  122. On Error Resume Next
  123.  
  124. DestroyApp
  125.  
  126. End Sub
  127.  
  128.