VERSION 5.00 Begin VB.Form frmMain Caption = "Form1" ClientHeight = 3960 ClientLeft = 60 ClientTop = 345 ClientWidth = 6135 LinkTopic = "Form1" ScaleHeight = 3960 ScaleWidth = 6135 StartUpPosition = 3 'Windows Default End Attribute VB_Name = "frmMain" Attribute VB_GlobalNameSpace = False Attribute VB_Creatable = False Attribute VB_PredeclaredId = True Attribute VB_Exposed = False Option Explicit Private Declare Function QueryPerformanceCounter Lib "Kernel32" (lpPerformanceCount As Currency) As Long Private Declare Function QueryPerformanceFrequency Lib "Kernel32" (lpPerformanceCount As Currency) As Long Private Const NEUTRAL_BYTE As Long = &H0 Private Const UP_BYTE As Long = &H1 Private Const DOWN_BYTE As Long = &H2 Private Const LEFT_BYTE As Long = &H4 Private Const RIGHT_BYTE As Long = &H8 Private Const LP_BYTE As Long = &H10 Private Const MP_BYTE As Long = &H20 Private Const HP_BYTE As Long = &H40 Private Const LK_BYTE As Long = &H80 Private Const MK_BYTE As Long = &H100 Private Const HK_BYTE As Long = &H200 Private DirectX8 As DirectX8 Private Direct_Input As DirectInput8 Private Keyboard_Device As DirectInputDevice8 Private Keyboard_State As DIKEYBOARDSTATE Private Running As Boolean Private Ticks_Per_Second As Currency Private Current_Time As Currency Private New_Time As Currency Private Delta_Time As Currency Private Accumulator As Currency Private Time_Step As Single Private Time As Currency Private Byte_Control As Long Private Old_Byte_Control As Long Private Bytes(10) As Long Private Flag(108) As Boolean Private C(10) As Long Private I As Long Private Stack_Count As Long Private Move_Stack() As Long Private Move_Event As Long Private Byte_Event As Long Private Sub Main() AutoRedraw = True Running = True Time_Step = 1 / 1000 DirectInput_Initialize_Keyboard frmMain.hWnd QueryPerformanceFrequency Ticks_Per_Second Game_Loop End Sub Private Function Get_Elapsed_Time_Per_Frame() As Single Static Last_Time As Currency Static Current_Time As Currency QueryPerformanceCounter Current_Time Get_Elapsed_Time_Per_Frame = (Current_Time - Last_Time) / Ticks_Per_Second QueryPerformanceCounter Last_Time End Function Private Function Get_Elapsed_Time() As Single Dim Last_Time As Currency Dim Current_Time As Currency QueryPerformanceCounter Current_Time Get_Elapsed_Time = (Current_Time - Last_Time) / Ticks_Per_Second QueryPerformanceCounter Last_Time End Function Private Function Get_FPS(Optional ByVal Elapsed_Frames As Long = 1) As Long Static Last_Time As Currency Dim Current_Time As Currency QueryPerformanceCounter Current_Time Get_FPS = Int(Elapsed_Frames * Ticks_Per_Second / (Current_Time - Last_Time)) QueryPerformanceCounter Last_Time End Function Private Sub Lock_Framerate(Target_FPS As Long) Static Last_Time As Currency Dim Current_Time As Currency Dim FPS As Single Do QueryPerformanceCounter Current_Time FPS = Ticks_Per_Second / (Current_Time - Last_Time) Loop While (FPS > Target_FPS) QueryPerformanceCounter Last_Time End Sub Private Sub DirectInput_Initialize_Keyboard(Window As Long) Set DirectX8 = New DirectX8 Set Direct_Input = DirectX8.DirectInputCreate Set Keyboard_Device = Direct_Input.CreateDevice("GUID_SysKeyboard") Keyboard_Device.SetCommonDataFormat DIFORMAT_KEYBOARD Keyboard_Device.SetCooperativeLevel Window, DISCL_BACKGROUND Or DISCL_NONEXCLUSIVE Keyboard_Device.Acquire Keyboard_Device.GetDeviceStateKeyboard Keyboard_State End Sub Private Function DirectInput_Key_State(Key_Code As Long) As Long Keyboard_Device.GetDeviceStateKeyboard Keyboard_State DirectInput_Key_State = Keyboard_State.Key(Key_Code) End Function Private Sub Close_Program() Set DirectX8 = Nothing Set Direct_Input = Nothing Set Keyboard_Device = Nothing Running = False Unload Me End End Sub Private Sub Control() Byte_Control = 0 Bytes(0) = NEUTRAL_BYTE Bytes(1) = UP_BYTE Bytes(2) = DOWN_BYTE Bytes(3) = LEFT_BYTE Bytes(4) = RIGHT_BYTE Bytes(5) = LP_BYTE Bytes(6) = MP_BYTE Bytes(7) = HP_BYTE Bytes(8) = LK_BYTE Bytes(9) = MK_BYTE Bytes(10) = HK_BYTE C(0) = 128 C(1) = DirectInput_Key_State(DIK_UP) C(2) = DirectInput_Key_State(DIK_DOWN) C(3) = DirectInput_Key_State(DIK_LEFT) C(4) = DirectInput_Key_State(DIK_RIGHT) C(5) = DirectInput_Key_State(DIK_A) C(6) = DirectInput_Key_State(DIK_S) C(7) = DirectInput_Key_State(DIK_D) C(8) = DirectInput_Key_State(DIK_Z) C(9) = DirectInput_Key_State(DIK_X) C(10) = DirectInput_Key_State(DIK_C) For I = 1 To 10 If C(I) <> 0 Then '----------------- 'Continuous events '----------------- Byte_Control = Byte_Control Or Bytes(I) ReDim Preserve Move_Stack(Stack_Count) As Long Move_Stack(Stack_Count) = Byte_Control If Flag(I) = False Then '----------------- 'One shot events '----------------- Stack_Count = Stack_Count + 1 Flag(I) = True End If Else Flag(I) = False End If Next I If C(1) = 0 And C(2) = 0 And C(3) = 0 And C(4) = 0 And C(5) = 0 And _ C(6) = 0 And C(7) = 0 And C(8) = 0 And C(9) = 0 And C(10) = 0 Then '----------------- 'Continuous events '----------------- C(0) = 128 Byte_Control = Byte_Control Or Bytes(0) ReDim Preserve Move_Stack(Stack_Count) As Long Move_Stack(Stack_Count) = Byte_Control If Flag(0) = False Then '----------------- 'One shot events '----------------- Stack_Count = Stack_Count + 1 Flag(0) = True End If Else C(0) = 0 Flag(0) = False End If End Sub Private Sub Render() Print "Buttons Pressed" Print "---------------" Print "Neutral: " & C(0) Print "Up: " & C(1), "Down: " & C(2), "Left: " & C(3), "Right: " & C(4) Print "LP (A): " & C(5), "MP (S): " & C(6), "HP (D): " & C(7) Print "LK (Z): " & C(8), "MK (X): " & C(9), "HK (C): " & C(10) Print Caption = Stack_Count - 1 Print Move_Stack(Stack_Count - 1) Print Print "Bytes" Print Byte_Control Print Print "Time held down" Print Time End Sub Private Sub Game_Loop() Do While Running = True DoEvents Lock_Framerate 60 frmMain.Cls Old_Byte_Control = Byte_Control Control Render Delta_Time = Get_Elapsed_Time_Per_Frame If Delta_Time > 0.25 Then Delta_Time = 0.25 Accumulator = Accumulator + Delta_Time While (Accumulator >= Time_Step) DoEvents Accumulator = Accumulator - Time_Step Time = Time + Time_Step Wend Print Old_Byte_Control If Byte_Control <> Old_Byte_Control Then Time = 0 Loop End Sub Private Sub Form_Activate() Main End Sub Private Sub Form_Unload(Cancel As Integer) Close_Program End Sub