i'm a but stuck with a snake game I am trying to make, it seems that at the moment the "HEAD" of the snake (this is a colored cell that is green with a green "x") will move perfectly and continuously till the end of the game playing board and stops at the boarder as i want. But it will not pickup any other key presses whilst it is moving.
Is there a way another key press can interrupt any other subs running.
I would really appreciate any help from you guys or maybe another way of doing it.
Option Explicit
Public speed As Integer
Dim r As Integer
Dim c As Integer
Dim moves As Boolean
Public Declare PtrSafe Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As LongPtr)
...
Public Sub start()
Application.ScreenUpdating = False
Application.OnKey "{LEFT}", "k_left"
Application.OnKey "{UP}", "k_up"
Application.OnKey "{DOWN}", "k_down"
Application.OnKey "{RIGHT}", "k_right"
Application.ScreenUpdating = True
End Sub
....
Function go_Speed(x As Integer)
speed = 300 / x
End Function
....
Sub movecheck()
Do While moves = True
Call k_move(r, c)
Loop
End Sub
....
Function k_move(rows As Integer, columns As Integer)
DoEvents
Sleep (speed)
Dim a As Range
For Each a In Range("E4:ak37")
If a.Value = "x" Then
If a.Offset(rows, columns).Interior.Color <> RGB(255, 255, 255) Then
'''crash check call goes here
moves = False
Exit Function
Else
a.Interior.Color = RGB(255, 255, 255)
a.Offset(rows, columns).Interior.Color = RGB(78, 238, 148)
a.Offset(rows, columns).Font.Color = RGB(78, 238, 148)
a.Offset(rows, columns) = a.Value
a.Cells.Clear
a.Cells.BorderAround 1
movecheck
End If
End If
Next a
End Function
....
Sub k_left()
moves = False
r = 0
c = -1
moves = True
Call movecheck
End Sub
....
Sub k_up()
moves = False
r = -1
c = 0
moves = True
Call movecheck
End Sub
....
Sub k_down()
moves = False
r = 1
c = 0
moves = True
Call movecheck
End Sub
.....
Sub k_right()
moves = False
r = 0
c = 1
moves = True
Call movecheck
End Sub
.....
See Question&Answers more detail:os