modcam.bas

一个游戏的原代码

Attribute VB_Name = "modCam"
Option Explicit

Public objInput As DirectInput8
Public KeyboardState As DIKEYBOARDSTATE, KeyStates(255) As Boolean
Public diKeyboard As DirectInputDevice8
Public diMouse As DirectInputDevice8
Public MouseState As DIMOUSESTATE, MouseStates(1) As Boolean

Public Enum MVB_KEYSTATE
MVB_DOWN = 1
MVB_PRESSED = 2
MVB_UP = 3
MVB_NONE = 0
End Enum

Private Type MVB_MOUSE
 mX As Long
 mY As Long
 BtnLft As MVB_KEYSTATE
 BtnRght As MVB_KEYSTATE
 MovementX As Single
 MovementY As Single
End Type
Public Mouse As MVB_MOUSE


'Camera-Info
Public Type MVB_PLAYERDATA
 vPPos As D3DVECTOR
 vPLookAt As D3DVECTOR
 vVelo As D3DVECTOR
 Speed As Single
 ViewDirX As Single
 ViewDirY As Single
End Type
Public player As MVB_PLAYERDATA

Private Frustum(5) As D3DPLANE
Private Enum FrustumSide
 FS_RIGHT = 0          ' The RIGHT side of the frustum
 FS_LEFT = 1           ' The LEFT  side of the frustum
 FS_BOTTOM = 2         ' The BOTTOM side of the frustum
 FS_TOP = 3            ' The TOP side of the frustum
 FS_BACK = 4           ' The BACK side of the frustum
 FS_FRONT = 5          ' The FRONT side of the frustum
End Enum

Dim matClip As D3DMATRIX
Dim Ic As Long

Dim cXmove As Single
Dim cYmove As Single
Dim cZmove As Single
Public lala As Boolean

Public Sub InitCam()
Set objInput = DirectX.DirectInputCreate()
Set diKeyboard = objInput.CreateDevice("GUID_SysKeyboard")
Set diMouse = objInput.CreateDevice("GUID_SysMouse")

player.Speed = 125
player.ViewDirY = 45
player.vPPos.Y = 0
player.vPPos.X = 0
player.vPPos.Z = 0
'Initialize DirectInput using Keyboard
diKeyboard.SetCommonDataFormat DIFORMAT_KEYBOARD
diKeyboard.SetCooperativeLevel frmMain.hwnd, DISCL_BACKGROUND Or DISCL_NONEXCLUSIVE
diKeyboard.Acquire
'Initialize DirectInput using Mouse
diMouse.SetCommonDataFormat DIFORMAT_MOUSE
diMouse.SetCooperativeLevel frmMain.hwnd, DISCL_BACKGROUND Or DISCL_NONEXCLUSIVE
diMouse.Acquire
End Sub

Private Sub GetMouseState()
diMouse.GetDeviceStateMouse MouseState
    Mouse.mY = Mouse.mY + MouseState.lY
    Mouse.mX = Mouse.mX + MouseState.lX
    Mouse.MovementX = MouseState.lX
    Mouse.MovementY = MouseState.lY


    If MouseState.Buttons(0) <> 0 And MouseStates(0) = False Then
    Mouse.BtnLft = MVB_DOWN
    MouseStates(0) = True
    ElseIf MouseState.Buttons(0) = 0 And MouseStates(0) = True Then
    Mouse.BtnLft = MVB_UP
    MouseStates(0) = False
    ElseIf MouseState.Buttons(0) <> 0 And MouseStates(0) = True Then
    Mouse.BtnLft = MVB_PRESSED
    Else
    Mouse.BtnLft = MVB_NONE
    End If

    If MouseState.Buttons(1) <> 0 And MouseStates(1) = False Then
    Mouse.BtnRght = MVB_DOWN
    MouseStates(1) = True
    ElseIf MouseState.Buttons(1) = 0 And MouseStates(1) = True Then
    Mouse.BtnRght = MVB_UP
    MouseStates(1) = False
    ElseIf MouseState.Buttons(1) <> 0 And MouseStates(1) = True Then
    Mouse.BtnRght = MVB_PRESSED
    Else
    Mouse.BtnRght = MVB_NONE
    End If
    
    If Mouse.mX < 0 Then Mouse.mX = 0
    If Mouse.mY < 0 Then Mouse.mY = 0
    If Mouse.mX > frmMain.ScaleWidth Then Mouse.mX = frmMain.Width
    If Mouse.mY > frmMain.ScaleHeight Then Mouse.mY = frmMain.ScaleHeight
End Sub

Public Function CheckKey(KeyNum As CONST_DIKEYFLAGS) As MVB_KEYSTATE
On Error GoTo LeaveFunction
diKeyboard.GetDeviceStateKeyboard KeyboardState
If KeyboardState.Key(KeyNum) <> 0 And KeyStates(KeyNum) = False Then
 CheckKey = MVB_DOWN
 KeyStates(KeyNum) = True
ElseIf KeyboardState.Key(KeyNum) = 0 And KeyStates(KeyNum) = True Then
 CheckKey = MVB_UP
 KeyStates(KeyNum) = False
ElseIf KeyboardState.Key(KeyNum) <> 0 And KeyStates(KeyNum) = True Then
 CheckKey = MVB_PRESSED
Else
 CheckKey = MVB_NONE
End If
Exit Function
LeaveFunction:
'Restore
End Function

Public Sub Movement()
GetMouseState
If Mouse.BtnRght = MVB_PRESSED Then
player.Speed = player.Speed + Mouse.MovementY
End If

If Mouse.BtnLft = MVB_PRESSED Then
    player.ViewDirY = player.ViewDirY - (Mouse.MovementY * 0.4)
    player.ViewDirX = player.ViewDirX - (Mouse.MovementX * 0.4)
End If

If player.ViewDirX < 0 Then player.ViewDirX = 360
If player.ViewDirX > 360 Then player.ViewDirX = 0

If player.ViewDirY <= -89.8 Then player.ViewDirY = -89.8
If player.ViewDirY >= 89.8 Then player.ViewDirY = 89.8
End Sub

Public Sub SetCam()
'Calculate the Player-LookAt-Coordinates
player.vPLookAt.X = (player.Speed * CoSine(player.ViewDirX)) * (CoSine(player.ViewDirY))
player.vPLookAt.Z = (player.Speed * Sine(player.ViewDirX)) * (CoSine(player.ViewDirY))
player.vPLookAt.Y = player.Speed * Sine(player.ViewDirY)

D3DXMatrixLookAtLH matView, player.vPLookAt, player.vPPos, MakeVector(0#, 1#, 0#)
D3Ddevice.SetTransform D3DTS_VIEW, matView
End Sub