Я пытаюсь сделать классическую игру «Снейк» в VB.NET, но если я удерживаю клавишу (любую клавишу) во время игры, через несколько секунд игра зависает, пока я не отпущу ключ. Я много пытался это исправить, но ничего не работает, может быть, потому что я не понимаю проблему.
Я предполагаю, что когда я удерживаю клавишу, вызывается функция Form1_KeyDown, и когда через несколько секунд клавиша переходит в режим «Я удерживаюсь», эта функция вызывается постоянно, поэтому таймеры не имеют возможности обновить. Но, как я уже сказал, я, вероятно, ошибаюсь.
Буду признателен за любую помощь, я боролся с этим некоторое время. Я думаю, что это весь необходимый код, пожалуйста, дайте мне знать, если это не так.
Код события нажатия клавиши:
Private Sub Form1_KeyDown(ByVal sender As Object, ByVal e As System.Windows.Forms.KeyEventArgs) Handles Me.KeyDown
' Sorts out all the key presses: movement, resetting, pausing
' Change direction, unless the player tries to travel backwards into themself
Select Case e.KeyCode
Case upKey
If previousDirection <> "D" Then
nextDirection = "U"
End If
Case leftKey
If previousDirection <> "R" Then
nextDirection = "L"
End If
Case rightKey
If previousDirection <> "L" Then
nextDirection = "R"
End If
Case downKey
If previousDirection <> "U" Then
nextDirection = "D"
End If
Case resetKey
resetGame()
Case pauseKey
paused = Not paused
If paused Then
lblPaused.Visible = True
tmrTime.Stop()
tmrFruit.Stop()
tmrMove.Stop()
Else
lblPaused.Visible = False
tmrTime.Start()
tmrFruit.Start()
tmrMove.Start()
End If
End Select
End Sub
Код для таймера, который обновляет / перемещает змею (я знаю, что это действительно неэффективно):
Private Sub tmrMove_Tick(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles tmrMove.Tick
' Adds a new head in direction of travel, and removes the tail, giving the illusion of snake movement
Dim head As Object = bodyParts(bodyParts.Count - 1)
Dim tail As Object = bodyParts(0)
Dim newHead As Object
head.Text = ""
' Add new head
Select Case nextDirection
Case "R"
' If snake goes out of bounds
If head.Tag(0) + 1 >= numberOfColumns Then
newHead = grid(0, head.Tag(1))
If newHead.BackColor = snakeColor Then
killSnake()
End If
Else
' If snake overlaps itself
If bodyParts.Contains(grid(head.Tag(0) + 1, head.Tag(1))) Then
killSnake()
Exit Sub
Else
' If snake is fine
newHead = grid(head.Tag(0) + 1, head.Tag(1))
End If
End If
' If fruit taken
If newHead.BackColor = fruitColor Then
eatFruit(newHead, tail)
End If
Case "L"
If head.Tag(0) - 1 < 0 Then
newHead = grid(numberOfColumns - 1, head.Tag(1))
If newHead.BackColor = snakeColor Then
killSnake()
End If
Else
If bodyParts.Contains(grid(head.Tag(0) - 1, head.Tag(1))) Then
killSnake()
Exit Sub
Else
newHead = grid(head.Tag(0) - 1, head.Tag(1))
End If
End If
If newHead.BackColor = fruitColor Then
eatFruit(newHead, tail)
End If
Case "U"
If head.Tag(1) - 1 < 0 Then
newHead = grid(head.Tag(0), numberOfRows - 1)
If newHead.BackColor = snakeColor Then
killSnake()
End If
Else
If bodyParts.Contains(grid(head.Tag(0), head.Tag(1) - 1)) Then
killSnake()
Exit Sub
Else
newHead = grid(head.Tag(0), head.Tag(1) - 1)
End If
End If
If newHead.BackColor = fruitColor Then
eatFruit(newHead, tail)
End If
Case "D"
If head.Tag(1) + 1 >= numberOfRows Then
newHead = grid(head.Tag(0), 0)
Else
If bodyParts.Contains(grid(head.Tag(0), head.Tag(1) + 1)) Then
killSnake()
Exit Sub
Else
newHead = grid(head.Tag(0), head.Tag(1) + 1)
End If
End If
If newHead.BackColor = fruitColor Then
eatFruit(newHead, tail)
End If
Case Else
newHead = grid(head.Tag(0), head.Tag(1))
End Select
bodyParts.Add(newHead)
newHead.BackColor = snakeColor
newHead.Font = headFont
newHead.Text = headText
' Remove tail
tail.BackColor = gridColor
bodyParts.RemoveAt(0)
previousDirection = nextDirection
End Sub