Option Explicit
Private Type POINT2D
X As Single
Y As Single
End Type
Private Type VECTOR2D
X As Single
Y As Single
End Type
Private Type TIME_TYPE
Initial As Single
Current As Single
End Type
Private Type SPRITE2D
Force As VECTOR2D
Velocity As VECTOR2D
Position As POINT2D
Acceleration As POINT2D
Mass As Single
Elasticity As Single
Time As TIME_TYPE
End Type
Private Declare Function QueryPerformanceCounter Lib "Kernel32" (lpPerformanceCount As Currency) As Long
Private Declare Function QueryPerformanceFrequency Lib "Kernel32" (lpPerformanceCount As Currency) As Long
Private Const dt As Single = 0.01
Private Const GRAVITY As Single = 9.80665
Private Const SCALAR As Single = 100
Private Sprite As SPRITE2D
Private Center As POINT2D
Private Running As Boolean
Private Initial_Time As Single
Private Current_Time As Single
Private New_Time As Single
Private Delta_Time As Single
Private Accumulator As Single
Private Ticks_Per_Second As Currency
Private Start_Time As Currency
Private Function Hi_Res_Timer_Initialize() As Boolean
If QueryPerformanceFrequency(Ticks_Per_Second) = 0 Then
Hi_Res_Timer_Initialize = False
Else
QueryPerformanceCounter Start_Time
Hi_Res_Timer_Initialize = True
End If
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 Lock_FPS(ByVal Target_FPS As Byte) As Single
If Target_FPS = 0 Then Target_FPS = 1
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 Function
Private Sub Integrate()
Sprite.Acceleration.X = Sprite.Force.X / Sprite.Mass
Sprite.Acceleration.Y = Sprite.Force.Y / Sprite.Mass
Sprite.Position.X = Sprite.Position.X + (Sprite.Velocity.X * dt)
Sprite.Velocity.X = Sprite.Velocity.X + (Sprite.Acceleration.X * dt)
Sprite.Position.Y = Sprite.Position.Y + (Sprite.Velocity.Y * dt)
Sprite.Velocity.Y = Sprite.Velocity.Y + (Sprite.Acceleration.Y * dt)
End Sub
Private Sub Update_Time_Step()
New_Time = Get_Elapsed_Time - Initial_Time
Delta_Time = New_Time - Current_Time
Current_Time = New_Time
If Delta_Time > 0.25 Then Delta_Time = 0.25
Accumulator = Accumulator + dt
While (Accumulator >= dt)
Accumulator = Accumulator - dt
Integrate
Sprite.Time.Current = Sprite.Time.Current + dt
Wend
End Sub
Private Sub Render()
Dim X As Single, Y As Single
X = Center.X + Sprite.Position.X * SCALAR
Y = Center.Y - Sprite.Position.Y * SCALAR
Image1.Left = X
Image1.Top = Y
End Sub
Private Sub Collision()
If Image1.Top > 150 Then
Image1.Top = 150
Me.Caption = Sprite.Velocity.Y
If Sprite.Velocity.Y < Sprite.Elasticity Then
Sprite.Velocity.Y = -Sprite.Velocity.Y * Sprite.Elasticity
Else
End If
End If
End Sub
Private Sub UserForm_Activate()
'ScaleMode = 3
'AutoRedraw = True
Hi_Res_Timer_Initialize
Center.X = Me.Width / 2
Center.Y = Me.Height / 2
Initial_Time = Get_Elapsed_Time
With Sprite
.Time.Initial = Get_Elapsed_Time
.Mass = 1
.Elasticity = 0.9
.Force.X = .Mass * 0
.Force.Y = .Mass * -GRAVITY
.Velocity.X = 0
.Velocity.Y = 0
End With
Running = True
Do While Running = True
DoEvents
Lock_FPS 60
Update_Time_Step
Render
Collision
QueryPerformanceCounter Start_Time
Loop
End Sub
Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
Running = False
Unload Me
End
End Sub
