当我按住键时,为什么我的VB.NET Snake游戏会冻结?

时间:2011-12-24 18:11:47

标签: vb.net timer freeze keydown

我正在尝试在VB.NET中制作经典的Snake游戏,但是如果我在游戏中持有一把钥匙(任何钥匙),几秒钟之后游戏会冻结,直到我释放钥匙。我已经尝试了很多来解决这个问题,但没有任何作用,可能是因为我不明白这个问题。

我假设当我按住某个键时,会调用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

3 个答案:

答案 0 :(得分:3)

  

我假设当我按住某个键时,会调用Form1_KeyDown函数,并且在几秒钟之后,当键进入“我被按下”模式时,该函数会不断被调用,所以计时器没有机会更新。但就像我说的那样,我可能错了。

事实上,你是对的。

在Windows中,只要按下该键,您就会收到WM_KEYDOWN消息,然后,在一定时间间隔后,您将获得大量WM_KEYDOWN条消息它们。

如果您转到控制面板 - 键盘,则可以找到这些间隔。

修复它的最简单方法是在密钥处理程序的末尾添加对DoEvents的调用。

尝试完全删除keydown处理程序。相反,通过检查Keyboard.IsKeyDown,在nextDirection的开头标记tmrMove_Tick

尝试完全删除keydown处理程序。相反,通过检查nextDirection,在tmrMove_Tick的开头标记GetAsyncKeyState,您可以声明如下:

Private Declare Function GetAsyncKeyState Lib "user32" Alias "GetAsyncKeyState" (ByVal vKey As Keys) As Short

Private Shared Function IsKeyDown(ByVal Key As Keys) As Boolean
    Return (GetAsyncKeyState(Key) And &H8000S) = &H8000S
End Function

答案 1 :(得分:1)

我建议尝试使用keyup事件。它不会像keypress或keydown事件那样发送垃圾邮件

答案 2 :(得分:0)

对于重复键的问题,你是正确的。我过去使用变量来保存前一个keystate并退出keypressed事件(如果它是相同的)。我正在使用一个计时器来重置它,这应该会让你有足够的延迟。

If oldKeyData = e.KeyCode Then
    e.Handled = True
    Exit Sub
End If

oldKeyData = e.KeyCode
tmrKeyReset.Enabled = True

编辑:@SpectralGhosts答案将适用于您想要按单个按键移动。