魔塔之拯救白娘子~我的第一个VB6+DX8做的小游戏源码~3鼠标键盘和手柄引擎

魔塔之拯救白娘子完整工程下载地址：
xInput.cls 这个模块处理鼠标键盘和手柄的输入。

'impactX Game Engine
'本类模块用于处理鼠标键盘和手柄的输入
'使用本类模块必须遵守:
'你可以免费使用本引擎及代码
'使用本引擎后的责任由使用者承担
'你可以任意拷贝本引擎代码，但必须保证其完整性
'希望我能得到你使用本引擎制作出的程序
'Davy.xu sunicdavy@sina.com qq:20998333Option Explicit
Dim di As DirectInput8
Dim DIDevice(0 To 4) As DirectInputDevice8 'DX输入设备
Dim diState As DIKEYBOARDSTATE '键盘按钮状态
Dim KeyState(255) As Integer
Dim JoyPadState(31) As Integer
Dim MouseState(3) As Integer
Dim m_hWnd As Long
''\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\鼠标\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\
Private Declare Function GetCursorPos Lib "USER32" (lpPoint As PointAPI) As Long
Private Declare Function showCursor Lib "USER32" Alias "ShowCursor" (ByVal bShow As Long) As Long
Private Declare Function GetKeyState Lib "USER32" (ByVal nVirtKey As Long) As Integer
Private Declare Function GetClientRect Lib "USER32" (ByVal hWnd As Long, lpRect As RECT) As Long
Private Declare Function ScreenToClient Lib "USER32" (ByVal hWnd As Long, lpPoint As PointAPI) As LongPrivate Type PointAPIx As Longy As Long
End TypeEnum ENUM_XG_MOUSEBUTTONxgL_BUTTON = 1xgR_BUTTON = 2xgM_BUTTON = 3
End Enum'\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\手柄\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\
Enum ENUM_XG_PSBUTTON 'PS改制手柄的键盘码，其他手柄的可能会有些出入xgPadUP = 13xgPadDOWN = 15xgPadLEFT = 14xgPadRIGHT = 16xgPadBTN1 = 1xgPadBTN2 = 2xgPadBTN3 = 3xgPadBTN4 = 4xgPadL1 = 7xgPadL2 = 8xgPadR1 = 5xgPadR2 = 6xgPadSTART = 9xgPadSELECT = 10
End Enum
'DirectInput设备枚举,列出手柄及其他输入设备
Dim diDevEnum As DirectInputEnumDevices8
'手柄状态,可以获取Axis的参数
Dim JoyCaps(4) As DIDEVCAPS
'可用手柄的数量
Dim m_JoyPadNum As Integer'\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\DirectInput基础函数\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\
'功能:初始化DirectInput
'参数:hWnd为窗体的句柄,若某窗口名称为Main，则可以获得Main.hWnd
Public Function InitDXInput(hWnd As Long) As BooleanOn Error GoTo ErrHm_hWnd = hWndDim DX As New DirectX8Set di = DX.DirectInputCreate()If Err.Number <> 0 ThenInitDXInput = FalseDebug.Print "Err [InitdxInput] DirectInput创建错误!"Exit FunctionEnd If'初始化键盘Set DIDevice(0) = di.CreateDevice("GUID_SysKeyboard") '创建键盘DIDevice(0).SetCommonDataFormat DIFORMAT_KEYBOARDDIDevice(0).SetCooperativeLevel hWnd, DISCL_BACKGROUND Or DISCL_NONEXCLUSIVEDIDevice(0).Acquire'初始化手柄Set diDevEnum = di.GetDIDevices(DI8DEVCLASS_GAMECTRL, DIEDFL_ATTACHEDONLY)m_JoyPadNum = CInt(diDevEnum.GetCount)
'    If diDevEnum.GetCount = 0 Then
'        Debug.Print "Warning [InitdxInput] 没有连接手柄"
'    End IfDim n As IntegerIf m_JoyPadNum > 4 Then m_JoyPadNum = 4For n = 1 To m_JoyPadNumSet DIDevice(n) = di.CreateDevice(diDevEnum.GetItem(n).GetGuidInstance)DIDevice(n).SetCommonDataFormat DIFORMAT_JOYSTICKDIDevice(n).SetCooperativeLevel hWnd, DISCL_BACKGROUND Or DISCL_NONEXCLUSIVEDIDevice(n).GetCapabilities JoyCaps(n)
'            Debug.Print "Pad:" & n
'            Debug.Print JoyCaps(n).lButtonsDIDevice(n).SetEventNotification 0DIDevice(n).AcquireNextInitDXInput = TrueExit FunctionErrH:InitDXInput = FalseDebug.Print "Err [InitdxInput] 初始化输入设备错误!"
End Function
'功能:卸载DirectInput
Public Sub UnloadDXInput()Dim i As IntegerFor i = 0 To 4If Not (DIDevice(i) Is Nothing) ThenDIDevice(i).UnacquireEnd IfNext iSet di = Nothing
End Sub
'\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\键盘相关函数\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\
'功能:指定的键盘按键是否按下
'CONST_DIKEYFLAGS请查看DXSDK或者本引擎的说明
Public Function KeyInput(ByVal KeyCode As CONST_DIKEYFLAGS, Optional ByVal Once As Boolean = False) As BooleanIf KeyCode < 0 Or KeyCode > 255 ThenDebug.Print "Err [GetKeyInput] 输入键盘检测码不在范围内!"Exit FunctionEnd IfDIDevice(0).GetDeviceStateKeyboard diStateKeyInput = IIf(diState.Key(KeyCode) = 0, False, True)If KeyInput ThenIf KeyState(KeyCode) > 0 And Once ThenKeyInput = FalseEnd IfIf KeyState(KeyCode) > 10000 Then KeyState(KeyCode) = 1KeyState(KeyCode) = KeyState(KeyCode) + 1ElseKeyState(KeyCode) = 0End If
End Function'\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\手柄相关函数\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\
'功能:获得可用的手柄个数
Public Function GetJoyPadNum() As IntegerGetJoyPadNum = m_JoyPadNum
End Function
'功能:获得可用手柄按钮个数
'参数:手柄号(例如JoyPadNum=1 为1号手柄)
Public Function GetBtnNum(JoyPadNum As Integer) As IntegerIf JoyPadNum < 0 Or JoyPadNum > m_JoyPadNum Then Exit FunctionGetBtnNum = JoyCaps(JoyPadNum).lButtons
End Function'功能:指定的按键码是否按下
'参数:手柄号(例如JoyPadNum=1 为1号手柄)
'       按钮:1~16
'注意:在Win2000以上可以调节手柄的Axis模式和Button模式
'       对于PS改制手柄 无论在Axis模式还是Button下本函数都会自动识别方向键Public Function JoyInput(ByVal JoyPadNum As Integer, ByVal Button As ENUM_XG_PSBUTTON, Optional Once As Boolean) As BooleanDim JoyState As DIJOYSTATEIf m_JoyPadNum = 0 ThenJoyInput = False'Debug.Print "Err:[Joyinput] 没有安装手柄"Exit FunctionEnd IfIf Button = 0 Then JoyInput = False: Exit FunctionButton = Button - 1 '纠正到WINDOWS里的按键码DIDevice(JoyPadNum).PollDIDevice(JoyPadNum).GetDeviceStateJoystick JoyStateIf JoyState.Buttons(Button) = 0 ThenJoyInput = FalseElseJoyInput = TrueEnd If'Axis模式下的号码对应Select Case ButtonCase 12If JoyState.y < 15000 Then JoyInput = TrueCase 14If JoyState.y > 50000 Then JoyInput = TrueCase 13If JoyState.x < 15000 Then JoyInput = TrueCase 15If JoyState.x > 50000 Then JoyInput = TrueEnd SelectIf JoyInput ThenIf JoyPadState(Button) > 0 And Once ThenJoyInput = FalseEnd IfJoyPadState(Button) = JoyPadState(Button) + 1ElseJoyPadState(Button) = 0End If
End Function
'\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\鼠标相关函数\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\'功能:返回鼠标X坐标
Public Function MouseX() As LongDim t As PointAPIDim Client As RECTGetCursorPos tGetClientRect m_hWnd, ClientScreenToClient m_hWnd, tMouseX = t.xIf t.x < Client.Left Then MouseX = 0If t.x > Client.Right Then MouseX = Client.RightEnd Function
'功能:返回鼠标Y坐标
Public Function MouseY() As LongDim t As PointAPIDim Client As RECTGetCursorPos tGetClientRect m_hWnd, ClientScreenToClient m_hWnd, tMouseY = t.yIf t.y < Client.Top Then MouseY = 0If t.y > Client.Bottom Then MouseY = Client.Bottom
End Function
'功能:隐藏鼠标
Public Sub HideMouse()Do: Loop Until showCursor(0) < 0
End Sub
'功能:显示鼠标
Public Sub ShowMouse()Do: Loop Until showCursor(1) > 0
End Sub
'功能:指定的鼠标按钮是否按下
'参数:由ENUM_XG_MOUSEBUTTON给出常用的鼠标按钮定义
Public Function MouseKey(ByVal KeyCode As ENUM_XG_MOUSEBUTTON, Optional ByVal Once As Boolean) As BooleanMouseKey = FalseSelect Case KeyCodeCase xgL_BUTTON '左键按下If (GetKeyState(vbKeyLButton) And &H8000) ThenMouseKey = TrueElseMouseKey = FalseEnd IfCase xgR_BUTTON '右键按下If (GetKeyState(vbKeyRButton) And &H8000) ThenMouseKey = TrueElseMouseKey = FalseEnd IfCase xgM_BUTTON '中间滚轮按下If (GetKeyState(vbKeyMButton) And &H8000) ThenMouseKey = TrueElseMouseKey = FalseEnd IfEnd SelectIf MouseKey ThenIf MouseState(KeyCode) > 0 And Once ThenMouseKey = FalseEnd IfMouseState(KeyCode) = MouseState(KeyCode) + 1ElseMouseState(KeyCode) = 0End IfIf MouseState(KeyCode) > 10000 Then MouseState(KeyCode) = 1
End Function

魔塔之拯救白娘子~我的第一个VB6+DX8做的小游戏源码~3鼠标键盘和手柄引擎相关推荐

魔塔之拯救白娘子~我的第一个VB6+DX8做的小游戏源码~20开始游戏-对话处理
魔塔之拯救白娘子完整工程下载地址: <魔塔之拯救白娘子>流程分析6:对话处理游戏的对话处理比较简单,仅仅是根据游戏流程提供简单的对话系统,没有涉及复杂的东西.下边是设计的窗体: Opt ...
魔塔之拯救白娘子~我的第一个VB6+DX8做的小游戏源码~1游戏引擎
魔塔之拯救白娘子完整工程下载地址: 前边学习了DX8的相关知识后,想做一个游戏试试看.这里我选取了魔塔这个比较大众化的小游戏.主要是魔塔的游戏画面比较固定,也很简单,似乎很容易做.下边就开始做吧. ...
魔塔之拯救白娘子~我的第一个VB6+DX8做的小游戏源码~24开始游戏-屏幕截图
魔塔之拯救白娘子完整工程下载地址: 魔塔之拯救白娘子>流程分析8:屏幕截图和通用申明有网友问我主窗口设计界面是什么样子?下图就是:frmMain.frm 设计界面非常清爽,只有一个tiemr ...
魔塔之拯救白娘子~我的第一个VB6+DX8做的小游戏源码~8地图编辑器-处理流程
魔塔之拯救白娘子完整工程下载地址: <魔塔之拯救白娘子>处理流程: ①在主游戏窗口里添加一个timer控件,名称为:timerDraw 作用:根据running状态绘制不同的背景 Ena ...
魔塔之拯救白娘子~我的第一个VB6+DX8做的小游戏源码~18开始游戏-物体碰撞检测
魔塔之拯救白娘子完整工程下载地址: <魔塔之拯救白娘子>流程分析4:物体碰撞检测处理方式分2步,第一步是游戏时主角显示处理:当主角移动时需要擦除上一个坐标位的主角,然后在新位置上放置主 ...
魔塔之拯救白娘子~我的第一个VB6+DX8做的小游戏源码~6地图编辑器-初始化
魔塔之拯救白娘子完整工程下载地址: 从今天开始我将写一下<魔塔之拯救白娘子>的游戏地图编辑器,俗话说,事半功倍.把地图编辑器搞好,基本一个游戏就写好了三分之一了.可以说,魔塔的地图是相对 ...
魔塔之拯救白娘子~我的第一个VB6+DX8做的小游戏源码~9地图编辑器-卡通选择
魔塔之拯救白娘子完整工程下载地址: <魔塔之拯救白娘子>地图编辑器:流程控制-卡通选择本课主要讲一下,卡通图片的选择.如下图所示. 卡通图片由3种: ①基础类:25个,主要是路面.NP ...
魔塔之拯救白娘子~我的第一个VB6+DX8做的小游戏源码~16开始游戏-自动寻路（A星算法）
魔塔之拯救白娘子完整工程下载地址: <魔塔之拯救白娘子>流程分析2: ⑤游戏界面鼠标点击判断以及自动寻路: 自动寻路的效果如下: 源码如下: Sub 游戏界面鼠标点击判断() Dim m ...
魔塔之拯救白娘子~我的第一个VB6+DX8做的小游戏源码~4读写ini文件
魔塔之拯救白娘子完整工程下载地址: 读写ini.bas 用来读写ini文件 Option Explicit '读写INI声明Dim TempBol Public iniFileName As Str ...

魔塔之拯救白娘子~我的第一个VB6+DX8做的小游戏源码~3鼠标键盘和手柄引擎

魔塔之拯救白娘子~我的第一个VB6+DX8做的小游戏源码~3鼠标键盘和手柄引擎相关推荐

最新文章

热门文章