为什么当我按住某个键时,我的 VB.NET 贪吃蛇游戏会冻结?

发布于 2024-12-22 21:37:10 字数 4931 浏览 4 评论 0原文

我正在尝试在 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

I'm trying to make the classic Snake game in VB.NET, but if I hold a key (any key) during the game, after a few seconds the game freezes until I release the key. I've tried lots to fix this, but nothing works, maybe because I don't understand the problem.

I'm assuming that when I hold down a key, the Form1_KeyDown function gets called, and when, after a few seconds, the key goes into "I'm being held down" mode, that function is constantly called, so the timers don't get a chance to update. But like I said, I'm probably wrong.

Any help at all would be appreciated, I've been struggling with this for a while. I think this is all the necessary code, please let me know if it isn't.

Code for key down event:

 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

Code for the timer that updates/moves the snake (I'm aware this is really inefficient):

 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

如果你对这篇内容有疑问,欢迎到本站社区发帖提问 参与讨论,获取更多帮助,或者扫码二维码加入 Web 技术交流群。

扫码二维码加入Web技术交流群

发布评论

需要 登录 才能够评论, 你可以免费 注册 一个本站的账号。

评论(3

并安 2024-12-29 21:37:10

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

事实上,你是对的。

在 Windows 中,只要按下某个键,您就会收到一条 WM_KEYDOWN 消息,然后,在一定时间间隔后,您会收到大量与另一个键相关的 WM_KEYDOWN 消息。它们之间有一定的间隔。

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

修复此问题的最简单方法是在按键处理程序末尾添加对 DoEvents 的调用。

尝试完全删除 keydown 处理程序。相反,通过检查 Keyboard.IsKeyDown

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

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

I'm assuming that when I hold down a key, the Form1_KeyDown function gets called, and when, after a few seconds, the key goes into "I'm being held down" mode, that function is constantly called, so the timers don't get a chance to update. But like I said, I'm probably wrong.

In fact, you are right.

In Windows you'll get a WM_KEYDOWN message as soon as the key is pressed, and then, after a certain interval, you'll be getting lots of WM_KEYDOWN messages with another certain interval between them.

You can find these intervals if you go to Control Panel - Keyboard.

The easiest way of fixing it is adding a call to DoEvents in the end of the key handler.

Try removing the keydown handler completely. Instead, figure nextDirection in the beginnig of tmrMove_Tick by examining Keyboard.IsKeyDown.

Try removing the keydown handler completely. Instead, figure nextDirection in the beginning of tmrMove_Tick by examining GetAsyncKeyState, which you can declare as follows:

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
沧笙踏歌 2024-12-29 21:37:10

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

I would recommend trying the keyup event instead. It won't spam like the keypress nor keydown events

渡你暖光 2024-12-29 21:37:10

您对按键重复问题的看法是正确的。我过去曾使用一个变量来保存之前的按键状态,如果相同则退出按键事件。我正在用一个计时器来重置它,这应该能让你有足够的延迟。

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

oldKeyData = e.KeyCode
tmrKeyReset.Enabled = True

编辑:如果您想通过单独的按键移动,@SpectralGhosts 的答案将会起作用。

You are correct with the problem being with the key repeating. I have in the past used a variable to hold the previous keystate and exit the keypressed event if it is the same. I am reseting this with a timer that should get you enough of a delay.

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

oldKeyData = e.KeyCode
tmrKeyReset.Enabled = True

Edit: @SpectralGhosts answer will work if you want to move with individual key presses.

~没有更多了~
我们使用 Cookies 和其他技术来定制您的体验包括您的登录状态等。通过阅读我们的 隐私政策 了解更多相关信息。 单击 接受 或继续使用网站,即表示您同意使用 Cookies 和您的相关数据。
原文