 |
{Contents of BioDI.bas} 'Biohazrd Engine 'Input Core '01/29/00 'By Peter Kuchnio 'http://voodoovb.talosstudios.com 'Additional modifications by Jeremy Clive Read 24th Dec 2003 and 7th August 2004 'http://www.pyrosoftware.net 'Requires DirectX7 TypeLib Dim dx As New DirectX7 'Variables Dim AbsoluteX As Long Dim AbsoluteY As Long 'DirectInput Device Public di As DirectInput 'Input devices (mouse & keyboard) Public DI_Mouse As DirectInputDevice Public DI_Keyboard As DirectInputDevice 'Device info Public MouseState As DIMOUSESTATE Public KeyboardState As DIKEYBOARDSTATE Public Type Di_Key 'This value is true whenever the key is pressed Pressed As Boolean 'This value is true only right when the user presses the key Active As Boolean NotLetUp As Boolean End Type Public Di_Keys(255) As Di_Key Public Sub DIinit(hwnd As Long) 'This subroutine will initialize DirectInput Set di = dx.DirectInputCreate 'Create mouse and keyboard devices & aquire Set DI_Mouse = di.CreateDevice("GUID_SysMouse") DI_Mouse.SetCommonDataFormat DIFORMAT_MOUSE DI_Mouse.SetCooperativeLevel hwnd, DISCL_BACKGROUND Or DISCL_NONEXCLUSIVE DI_Mouse.Acquire Set DI_Keyboard = di.CreateDevice("GUID_SysKeyboard") DI_Keyboard.SetCommonDataFormat DIFORMAT_KEYBOARD DI_Keyboard.SetCooperativeLevel hwnd, DISCL_BACKGROUND Or DISCL_NONEXCLUSIVE DI_Keyboard.Acquire End Sub Public Sub DIGetMouseState() 'Gets the coords and button status from the mouse DI_Mouse.GetDeviceStateMouse MouseState End Sub Public Sub DIGetKeyboardState() 'Polls the keyboard DI_Keyboard.GetDeviceStateKeyboard KeyboardState End Sub Public Function PollKeyboard() As String 'Polls the keyboard and returns a string Dim KeyCount As Long For KeyCount = 0 To 255 If KeyboardState.key(KeyCount) <> 0 Then PollKeyboard = StringFromKeycode(KeyCount) End If Next End Function Public Sub GetKeys() 'Loop counter Dim KeyCount As Long 'Get the current state of the keyboard DIGetKeyboardState 'Scan through all the keys to check which are depressed 'Active is only true right when the user presses the key 'Pressed is true as long as the key is depressed For KeyCount = 1 To 255 If KeyboardState.key(KeyCount) <> 0 Then If Di_Keys(KeyCount).Active = False And Di_Keys(KeyCount).NotLetUp = False Then Di_Keys(KeyCount).Active = True Di_Keys(KeyCount).NotLetUp = True Else If Di_Keys(KeyCount).NotLetUp = True Then Di_Keys(KeyCount).Active = False End If Di_Keys(KeyCount).Pressed = True Else Di_Keys(KeyCount).NotLetUp = False Di_Keys(KeyCount).Active = False Di_Keys(KeyCount).Pressed = False End If Next End Sub Public Function StringFromKeycode(ByVal key As Long) As String 'Returns a string for a keycode Select Case key Case DIK_1 StringFromKeycode = "1" Case DIK_2 StringFromKeycode = "2" Case DIK_3 StringFromKeycode = "3" Case DIK_4 StringFromKeycode = "4" Case DIK_5 StringFromKeycode = "5" Case DIK_6 StringFromKeycode = "6" Case DIK_7 StringFromKeycode = "7" Case DIK_8 StringFromKeycode = "8" Case DIK_9 StringFromKeycode = "9" Case DIK_0 StringFromKeycode = "0" Case DIK_A StringFromKeycode = "A" Case DIK_B StringFromKeycode = "B" Case DIK_C StringFromKeycode = "C" Case DIK_D StringFromKeycode = "D" Case DIK_E StringFromKeycode = "E" Case DIK_F StringFromKeycode = "F" Case DIK_G StringFromKeycode = "G" Case DIK_H StringFromKeycode = "H" Case DIK_I StringFromKeycode = "I" Case DIK_J StringFromKeycode = "J" Case DIK_K StringFromKeycode = "K" Case DIK_L StringFromKeycode = "L" Case DIK_M StringFromKeycode = "M" Case DIK_N StringFromKeycode = "N" Case DIK_O StringFromKeycode = "O" Case DIK_P StringFromKeycode = "P" Case DIK_Q StringFromKeycode = "Q" Case DIK_R StringFromKeycode = "R" Case DIK_S StringFromKeycode = "S" Case DIK_T StringFromKeycode = "T" Case DIK_U StringFromKeycode = "U" Case DIK_V StringFromKeycode = "V" Case DIK_W StringFromKeycode = "W" Case DIK_X StringFromKeycode = "X" Case DIK_Y StringFromKeycode = "Y" Case DIK_Z StringFromKeycode = "Z" Case DIK_LSHIFT StringFromKeycode = "SHIFT" Case DIK_RSHIFT StringFromKeycode = "SHIFT" Case DIK_COMMA StringFromKeycode = "<" Case DIK_PERIOD StringFromKeycode = ">" Case Else StringFromKeycode = CStr(key) End Select End Function Public Function KeycodeFromString(ByVal LetterString As String) As Long 'Returns a string for a keycode Select Case LetterString Case "1" KeycodeFromString = DIK_1 Case "2" KeycodeFromString = DIK_2 Case "3" KeycodeFromString = DIK_3 Case "4" KeycodeFromString = DIK_4 Case "5" KeycodeFromString = DIK_5 Case "6" KeycodeFromString = DIK_6 Case "7" KeycodeFromString = DIK_7 Case "8" KeycodeFromString = DIK_8 Case "9" KeycodeFromString = DIK_9 Case "0" KeycodeFromString = DIK_0 Case "A" KeycodeFromString = DIK_A Case "B" KeycodeFromString = DIK_B Case "C" KeycodeFromString = DIK_C Case "D" KeycodeFromString = DIK_D Case "E" KeycodeFromString = DIK_E Case "F" KeycodeFromString = DIK_F Case "G" KeycodeFromString = DIK_G Case "H" KeycodeFromString = DIK_H Case "I" KeycodeFromString = DIK_I Case "J" KeycodeFromString = DIK_J Case "K" KeycodeFromString = DIK_K Case "L" KeycodeFromString = DIK_L Case "M" KeycodeFromString = DIK_M Case "N" KeycodeFromString = DIK_N Case "O" KeycodeFromString = DIK_O Case "P" KeycodeFromString = DIK_P Case "Q" KeycodeFromString = DIK_Q Case "R" KeycodeFromString = DIK_R Case "S" KeycodeFromString = DIK_S Case "T" KeycodeFromString = DIK_T Case "U" KeycodeFromString = DIK_U Case "V" KeycodeFromString = DIK_V Case "W" KeycodeFromString = DIK_W Case "X" KeycodeFromString = DIK_X Case "Y" KeycodeFromString = DIK_Y Case "Z" KeycodeFromString = DIK_Z Case "F1" KeycodeFromString = DIK_F1 Case "F2" KeycodeFromString = DIK_F2 Case "F3" KeycodeFromString = DIK_F3 Case "F4" KeycodeFromString = DIK_F4 Case "F5" KeycodeFromString = DIK_F5 Case "F6" KeycodeFromString = DIK_F6 Case "F7" KeycodeFromString = DIK_F7 Case "F8" KeycodeFromString = DIK_F8 Case "F9" KeycodeFromString = DIK_F9 Case "F10" KeycodeFromString = DIK_F10 Case "F11" KeycodeFromString = DIK_F11 Case "F12" KeycodeFromString = DIK_F12 Case "<" KeycodeFromString = DIK_COMMA Case ">" KeycodeFromString = DIK_PERIOD End Select End Function Public Sub DIUnload() 'Unloads DirectInput Set DI_Mouse = Nothing Set DI_Keyboard = Nothing Set di = Nothing End Sub |
 |
|
Copyright © 2002 - 2004 Jeremy Clive Read
Pyrosoftware and other trademarks belong to their respective owners.