Snake - Ein weiterer Versuch

    • VB.NET

      Snake - Ein weiterer Versuch

      Im Bezug auf diesen Post (Und den darin verlinkten Thread) möchte ich meine Variante von Snake zeigen.

      Meine Variante generiert nicht ein Spielfeld und bringt die Schlange dort unter, sondern generiert eine Schlange und sagt ihr wo sie sich im (nicht existenten) Spielfeld befindet. Das spart bei größeren Spielfeldern Speicher (wobei das mehr oder weniger trivial ist).
      Weiters ist es möglich anstelle der einzelnen Schlange "TheSnake" eine List(Of Snake) anzulegen und so mehrere Schlangen auf dem Spielfeld zu haben. Jede Schlange hat dabei ihre eigenen Tasten zugeordnet. Was noch fehlt ist eine Kollisionsprüfung der Schlangen untereinander und eine Variable, die angibt, ob die Schlange noch im Spiel ist.

      Was neben dem Sourcecode benötigt wird:
      Eine Form "Form_Main" (schön ist ein weißer Hintergrund) mit DoubleBuffered auf True
      Eine neu angelegte Klasse "Snake" (Kann auch in der "Form_Main" Datei sein)
      Framework:
      * Im Framework 4.0 erstellt
      * Ohne Probleme auf 3.5 runterschraubbar
      * Ab 3.0 gibt es Probleme (Liste.First), die sich allerdings einfach lösen lassen (Liste(Liste.Count - 1))
      * 2.0: Das Selbe wie bei 3.0

      Das Ergebnis:


      Der Sourcecode:

      Form_Main:

      VB.NET-Quellcode

      1. Public Class Form_Main
      3. Dim WithEvents Timer_GameTick As New Timer With {.Interval = 70, .Enabled = True}
      5. Dim WithEvents TheSnake As Snake
      6. Dim TargetPoint As Point
      8. Dim FieldsX As Integer = 30
      9. Dim FieldsY As Integer = 30
      11. Dim Rnd As New Random
      13. Private Sub Initialize() Handles MyBase.Load
      14. NewSnake()
      15. TargetPointEaten()
      16. End Sub
      18. 'Schlange erstellen
      19. Private Sub NewSnake()
      20. TheSnake = New Snake(New Point(Rnd.Next(0, FieldsX), Rnd.Next(0, FieldsY)), Keys.Up, Keys.Down, Keys.Left, Keys.Right)
      21. End Sub
      23. 'Das "Fressen" wurde gefressen
      24. Private Sub TargetPointEaten() Handles TheSnake.TargetEaten
      25. 'Wenn die Schlange so lang ist, dass 1/4 aller Felder besetzt ist hat der Spieler gewonnen;
      26. 'Das kann noch angepasst werden
      27. If TheSnake.Lenght >= Math.Floor(FieldsX * FieldsY / 4) Then
      28. Timer_GameTick.Enabled = False
      29. Me.Invalidate()
      30. MessageBox.Show("Gewonnen!")
      31. NewSnake()
      32. Timer_GameTick.Enabled = True
      33. End If
      34. 'Das neue "Fressen" wird so lange neu generiert, bis es sich nicht in der Schlange befindet
      35. 'und es mindestens 4 Felder vom Kopf entfernt ist.
      36. Do
      37. TargetPoint = New Point(Rnd.Next(0, FieldsX), Rnd.Next(0, FieldsY))
      38. Loop While TheSnake.Points.Contains(TargetPoint) OrElse (TargetPoint.X - TheSnake.Points.Last.X) ^ 2 + (TargetPoint.Y - TheSnake.Points.Last.Y) ^ 2 < 4 ^ 2
      39. End Sub
      41. 'Die Schlange hat sich selbst gebissen
      42. Private Sub SelfEaten() Handles TheSnake.SelfEaten
      43. Timer_GameTick.Enabled = False
      44. Me.Invalidate()
      45. MessageBox.Show("Leider verloren!")
      46. NewSnake()
      47. TargetPointEaten()
      48. Timer_GameTick.Enabled = True
      49. End Sub
      51. 'Die Richtung der Schlange setzen;
      52. 'Durch die Angabe der Up, Down, Left und Right Keys der Schlange beim Instanzieren
      53. 'können so mehrere Schlangen auf dem Spielfeld sein (Es müsste eine Kollision untereinander abgefragt werden)
      54. Private Sub MeKeyDown(ByVal sender As Object, ByVal e As KeyEventArgs) Handles Me.KeyDown
      55. TheSnake.SetDirection(e.KeyCode)
      56. End Sub
      58. Private Sub MeSizeChanged() Handles Me.SizeChanged
      59. Me.Invalidate()
      60. End Sub
      62. 'Der Zyklus des Spiels
      63. Private Sub GameTick() Handles Timer_GameTick.Tick
      64. TheSnake.Go(TargetPoint, FieldsX, FieldsY)
      65. 'Der Punktestand wird hier über Me.Text ausgegeben;
      66. 'Kann auch zwischengespeichert und manuell gezeichnet werden
      67. Me.Text = "Snake: " & TheSnake.Lenght.ToString & " von " & (CInt(Math.Floor(FieldsX * FieldsY / 4))).ToString & " Punkte"
      68. Me.Invalidate()
      69. End Sub
      71. 'Hier wird gezeichnet;
      72. 'Ein paar Berechnungen sind nötig um das Gezeichnete immer in der Mitte zu halten
      73. Private Sub MePaint(ByVal sender As Object, ByVal e As PaintEventArgs) Handles Me.Paint
      74. Dim FieldWidth As Double
      75. Dim FieldHeight As Double
      76. Dim XOffset As Double = 0
      77. Dim YOffset As Double = 0
      78. If Me.ClientRectangle.Height / Me.ClientRectangle.Width < FieldsY / FieldsX Then
      79. FieldWidth = (Me.ClientRectangle.Height / FieldsY) * FieldsX
      80. FieldHeight = Me.ClientRectangle.Height
      81. XOffset = (Me.ClientRectangle.Width - FieldWidth) / 2
      82. End If
      83. If Me.ClientRectangle.Height / Me.ClientRectangle.Width = FieldsY / FieldsX Then
      84. FieldWidth = Me.ClientRectangle.Width
      85. FieldHeight = Me.ClientRectangle.Height
      86. End If
      87. If Me.ClientRectangle.Height / Me.ClientRectangle.Width > FieldsY / FieldsX Then
      88. FieldWidth = Me.ClientRectangle.Width
      89. FieldHeight = (Me.ClientRectangle.Width / FieldsX) * FieldsY
      90. YOffset = (Me.ClientRectangle.Height - FieldHeight) / 2
      91. End If
      92. Dim BlockSize As Double = FieldWidth / FieldsX 'Die Felder sind Quadratisch, es könnte also auch FieldHeight / FieldsY verwendet werden
      93. 'Rahmen außen
      94. e.Graphics.DrawRectangle(Pens.Black, CSng(XOffset), CSng(YOffset), CSng(FieldWidth - 1), CSng(FieldHeight - 1))
      95. 'Felder der Schlange
      96. For Each i As Point In TheSnake.Points
      97. e.Graphics.FillRectangle(Brushes.DarkGreen, CSng(XOffset + i.X * BlockSize), CSng(YOffset + i.Y * BlockSize), CSng(BlockSize), CSng(BlockSize))
      98. Next
      99. 'Das "Fressen"
      100. e.Graphics.FillEllipse(Brushes.DarkRed, CSng(XOffset + TargetPoint.X * BlockSize), CSng(YOffset + TargetPoint.Y * BlockSize), CSng(BlockSize), CSng(BlockSize))
      101. 'Der Kopf der Schlange wird noch mal mit einem helleren Grün hervorgehoben;
      102. 'Das dient der Erkennbarkeit
      103. e.Graphics.FillRectangle(Brushes.Lime, CSng(XOffset + TheSnake.Points.Last.X * BlockSize), CSng(YOffset + TheSnake.Points.Last.Y * BlockSize), CSng(BlockSize), CSng(BlockSize))
      104. End Sub
      106. End Class


      Snake:

      VB.NET-Quellcode

      1. Public Class Snake
      3. 'Gibt die Richtung an, in die sich die Schlange bewegen soll
      4. Public Enum SnakeDirection As Integer
      5. None = 0
      6. Left = 1
      7. Right = 2
      8. Up = 3
      9. Down = 4
      10. End Enum
      12. 'Die Properties sollten sich weitestgehend selbst erklären
      14. Public Shared Property LenghtIncrement As Integer = 5
      16. Public Event TargetEaten()
      17. Public Event SelfEaten()
      19. Public Property Lenght As Integer = 5
      20. Public Property Points As New List(Of Point)
      22. Dim LastDirection As SnakeDirection = SnakeDirection.None
      23. Dim ActualDirection As SnakeDirection = SnakeDirection.None
      25. 'Die Tasten können für jede Schlange separat angegeben werden;
      26. 'Dadurch können mehrere Schlangen auf dem Spielfeld sein
      27. Public Property UpKey As Keys
      28. Public Property DownKey As Keys
      29. Public Property LeftKey As Keys
      30. Public Property RightKey As Keys
      32. '0815 Konstruktor;
      33. 'Startpunkt hinzufügen und Keys übernehmen
      34. Public Sub New(ByVal StartPoint As Point, ByVal NewUpKey As Keys, ByVal NewDownKey As Keys, ByVal NewLeftKey As Keys, ByVal NewRightKey As Keys)
      35. Points.Add(StartPoint)
      36. UpKey = NewUpKey
      37. DownKey = NewDownKey
      38. LeftKey = NewLeftKey
      39. RightKey = NewRightKey
      40. End Sub
      42. 'Hier wird die neue Richtung der Schlange gesetzt
      43. Public Sub SetDirection(ByVal Key As Keys)
      44. Select Case Key
      45. Case UpKey
      46. 'Die Schlange darf keine 180° Wende machen;
      47. 'Da man zwischen zwei Ticks mehrere Male die Richtung ändern kann
      48. 'wird immer die letzte Richtung überprüft
      49. If Not LastDirection = SnakeDirection.Down Then
      50. ActualDirection = SnakeDirection.Up
      51. End If
      52. Case DownKey
      53. If Not LastDirection = SnakeDirection.Up Then
      54. ActualDirection = SnakeDirection.Down
      55. End If
      56. Case LeftKey
      57. If Not LastDirection = SnakeDirection.Right Then
      58. ActualDirection = SnakeDirection.Left
      59. End If
      60. Case RightKey
      61. If Not LastDirection = SnakeDirection.Left Then
      62. ActualDirection = SnakeDirection.Right
      63. End If
      64. End Select
      65. End Sub
      67. 'Hier "kriecht" die Schlange
      68. Public Sub Go(ByVal TargetPoint As Point, ByVal FieldsX As Integer, ByVal FieldsY As Integer)
      69. 'Die gesetzte Richtung wird übernommen
      70. LastDirection = ActualDirection
      71. 'Falls keine Richtung gesetzt ist (z.B. Am Anfang des Spiels) passiert nichts
      72. If Not ActualDirection = SnakeDirection.None Then
      73. Dim NewPoint As Point
      74. 'Anhand der Richtung wird ein neuer Punkt gesucht
      75. Select Case ActualDirection
      76. Case SnakeDirection.Up
      77. NewPoint = New Point(Points.Last.X, Points.Last.Y - 1)
      78. Case SnakeDirection.Down
      79. NewPoint = New Point(Points.Last.X, Points.Last.Y + 1)
      80. Case SnakeDirection.Left
      81. NewPoint = New Point(Points.Last.X - 1, Points.Last.Y)
      82. Case SnakeDirection.Right
      83. NewPoint = New Point(Points.Last.X + 1, Points.Last.Y)
      84. End Select
      85. 'Auf der einen Seite raus, auf der anderen wieder rein
      86. If NewPoint.X > FieldsX - 1 Then
      87. NewPoint = New Point(0, NewPoint.Y)
      88. ElseIf NewPoint.X < 0 Then
      89. NewPoint = New Point(FieldsX - 1, NewPoint.Y)
      90. End If
      91. If NewPoint.Y > FieldsY - 1 Then
      92. NewPoint = New Point(NewPoint.X, 0)
      93. ElseIf NewPoint.Y < 0 Then
      94. NewPoint = New Point(NewPoint.X, FieldsY - 1)
      95. End If
      96. 'Prüfen, ob sich die Schlange selbst beißt
      97. If Points.Contains(NewPoint) Then
      98. RaiseEvent SelfEaten()
      99. End If
      100. Points.Add(NewPoint)
      101. 'Prüfen, ob die Schlange das "Fressen" frisst
      102. If TargetPoint = NewPoint Then
      103. Lenght += LenghtIncrement
      104. RaiseEvent TargetEaten()
      105. End If
      106. RemoveLast()
      107. End If
      108. End Sub
      110. 'Wenn die Schlange länger ist als das Maximum wird der Schwanz abgeschnitten;
      111. 'Der Kopf ist immer Points.Last und der Schwanz ist immer Points.First
      112. Private Sub RemoveLast()
      113. Do While Points.Count > Lenght
      114. Points.RemoveAt(0)
      115. Loop
      116. End Sub
      118. End Class


      Verbesserungsvorschläge werden immer gerne gelesen ^^
      "Luckily luh... luckily it wasn't poi-"
      -- Brady in Wonderland, 23. Februar 2015, 1:56
      Desktop Pinner | ApplicationSettings | OnUtils

      Dieser Beitrag wurde bereits 1 mal editiert, zuletzt von „Niko Ortner“ ()

    Facebook