'==================================================VisualMonsters.cba.pl===================================================== Public Class Form1 'Realizowe kierunki podczas działania Timera Private Enum Kierunek wPrawo wDol wLewo wGore Pauza End Enum 'Struktura węża Private Structure StrukturaWeza Dim rect As Rectangle Dim x As Integer Dim y As Integer Dim KolorWeza As Color End Structure 'Określa wielkość gry, przyjmujemy kwadrat Dim wielkoscGry As Integer = 20 'Tablica przechowująca pola gry Private pola(,) As Rectangle 'Tablica przechowująca zajęte pola, gra skończy się jeśli wąż ugryzie samego siebie 'ta tablica czuwa nad tym Private zajetepola(,) As Boolean 'zmienna przechowuje aktualny kierunek Private aktKierunek As Kierunek Dim punkty As Integer = 0 Private Sub Form1_Load(sender As Object, e As EventArgs) Handles MyBase.Load 'inicjuje elementy gry, dzięki temu będzie można zagrać ponownie gdy gra się skończy initialize() End Sub Private Sub initialize() 'kierunek startowy aktKierunek = Kierunek.Pauza punkty = 0 'startowe punkty 'metoda określa GenerujPlanszeGry() GenerujWeza() GenerujToken() Timer1.Start() End Sub 'główna plansza gry na której będzie wyświetlana grafika Private PlanszaGlowna As New Bitmap(400, 400) Dim kolorPola As New SolidBrush(Color.FromArgb(50, 255, 0, 0)) Private Sub GenerujPlanszeGry() Dim g As Graphics = Graphics.FromImage(PlanszaGlowna) 'określamy wysokość i szerokość planszy Dim szerokosc As Integer = (400 / wielkoscGry) - 1 Dim wysokosc As Integer = (400 / wielkoscGry) - 1 ''powtarzamy inicjacje tablic aby zmienić ich wielkość ReDim pola(wielkoscGry, wielkoscGry) ReDim zajetepola(wielkoscGry, wielkoscGry) 'pętla ustawia wstępne wartości obiektów For j As Integer = 0 To wielkoscGry - 1 For i As Integer = 0 To wielkoscGry - 1 pola(j, i) = New Rectangle((szerokosc + 1) * j, (wysokosc + 1) * i, szerokosc, wysokosc) zajetepola(j, i) = False g.FillRectangle(kolorPola, pola(j, i)) 'dodaje grafikę do bitmapy Next Next 'zmienia tło formy Me.BackgroundImage = PlanszaGlowna g.Dispose() Me.Refresh() End Sub Private snake As Collection 'Kolekcja przechowujaca elementy naszego węża Private DlugoscStartowa As Integer = 3 'Startowa dlugość węża Private BiezacaDlugoscWeza As Integer 'Aktualna dlugość węża Private Sub GenerujWeza() 'generujemy strukturę i tworzymy nową kolekcję Dim sWaz As StrukturaWeza snake = New Collection 'określamy punkt startowy w którym pojawi się nasz wąż Dim x As Integer = 5 Dim y As Integer = 5 'kolekcje liczone są nie od 0 a od jeden For i As Integer = 0 To DlugoscStartowa - 1 'okreslamy parametry startowe dla kazdego elementu struktury sWaz.rect = pola(x, y) sWaz.x = x sWaz.y = y sWaz.KolorWeza = Color.Red 'dodajemy strukturę do kolekcji snake.Add(sWaz) Next 'zajmujemy pole startowe na którym znajduje sie waz zajetepola(x, y) = True BiezacaDlugoscWeza = DlugoscStartowa End Sub Private Sub Timer1_Tick(sender As Object, e As EventArgs) Handles Timer1.Tick PoruszWeza() Application.DoEvents() End Sub Private poswiata As Brush = New SolidBrush(Color.FromArgb(255, 255, 255)) 'KOLOR ZNIKAJĄCEGO KWADRACIKA POZOSTAWIAJACY OGON Dim jestemWruchu As Boolean = False Dim token As New Rectangle Private Sub PoruszWeza() 'tworzymy czystą planszę o równych wymiarach jak plansza gry Dim podgladgry As New Bitmap(400, 400) Dim g As Graphics = Graphics.FromImage(podgladgry) 'ZATRZYMUJE TIMER Timer1.Enabled = False 'deklarujemy strukturę Dim sWaz As StrukturaWeza 'usówamy ostatnią strukturę z kolekcji, sWaz = snake(snake.Count) 'wybieramy ostatni element g.FillRectangle(poswiata, sWaz.rect) 'element opcjonalny zostawia poświatę ogona snake.Remove(snake.Count) 'usówamy go zajetepola(sWaz.x, sWaz.y) = False 'zwalniamy zajęte pole 'teraz wybieramy pierszy element węża sWaz = snake.Item(1) 'deklarujemy zmienne w których umieścimy lokalizację pierwszego elementu węża Dim x As Integer = sWaz.x Dim y As Integer = sWaz.y 'sprawdzamy czy po dodaniu 1 zgodnie z ustalonym kierunkiem nasz wąż nie uderzył w krawędź planszy Select Case aktKierunek Case Kierunek.wPrawo x = x + 1 If x > wielkoscGry - 1 Then 'gracz uderzył w ścianę po prawej stronie Timer1.Enabled = False 'zatrzymuje timer If MessageBox.Show("Uderzyłeś w krawędź planszy, czy chcesz zacząć grę od nowa?", "Gra skończona!", MessageBoxButtons.YesNo, MessageBoxIcon.Question, MessageBoxDefaultButton.Button1) = Windows.Forms.DialogResult.Yes Then 'Jeśli gracz przycisną "Tak" gra zacznie się od nowa initialize() Exit Sub Else Exit Sub End If End If Case Kierunek.wGore y = y - 1 If y < 0 Then Timer1.Enabled = False If MessageBox.Show("Uderzyłeś w krawędź planszy, czy chcesz zacząć grę od nowa?", "Gra skończona!", MessageBoxButtons.YesNo, MessageBoxIcon.Question, MessageBoxDefaultButton.Button1) = Windows.Forms.DialogResult.Yes Then initialize() Exit Sub Else Exit Sub End If End If Case Kierunek.wDol y = y + 1 If y > wielkoscGry - 1 Then Timer1.Enabled = False If MessageBox.Show("Uderzyłeś w krawędź planszy, czy chcesz zacząć grę od nowa?", "Gra skończona!", MessageBoxButtons.YesNo, MessageBoxIcon.Question, MessageBoxDefaultButton.Button1) = Windows.Forms.DialogResult.Yes Then initialize() Exit Sub Else Exit Sub End If End If Case Kierunek.wLewo x = x - 1 If x < 0 Then Timer1.Enabled = False If MessageBox.Show("Uderzyłeś w krawędź planszy, czy chcesz zacząć grę od nowa?", "Gra skończona!", MessageBoxButtons.YesNo, MessageBoxIcon.Question, MessageBoxDefaultButton.Button1) = Windows.Forms.DialogResult.Yes Then initialize() Exit Sub Else Exit Sub End If End If End Select 'ten element odpowiedziany jest za przesunięcie pierwszego elementu węża 'jeśli wciśnięta jest Pauza(Spacja) wąż nie zostanie przesunięty If Not aktKierunek = Kierunek.Pauza Then If zajetepola(x, y) = True Then 'wąż zderzył się z samym sobą Timer1.Enabled = False If MessageBox.Show("Zjadłeś własny ogon, czy chcesz zacząć grę od nowa?", "Gra skończona!", MessageBoxButtons.YesNo, MessageBoxIcon.Question, MessageBoxDefaultButton.Button1) = Windows.Forms.DialogResult.Yes Then initialize() Exit Sub Else Exit Sub End If End If 'na podstawie kierunku, zmienna x lub y została zmieniona 'ta struktura (sWaz) nie jest jeszcze dodana do kolekcji, dlatego jej zmiennymi 'możemy jeszcze manipulować sWaz.x = x sWaz.y = y sWaz.rect = pola(x, y) zajetepola(x, y) = True 'zajmuje nowe pole End If 'nowa struktura koloru wężą, nie dodana jeszcze głowa 'można ten element pominąć wstawiając w tym miejscu snake.Add(sWaz, , 1) 'lub można zrobić inny kolor dla głowy węża g.FillRectangle(New SolidBrush(sWaz.KolorWeza), sWaz.rect) 'koloruje leszcze elementów kolekcji For t As Integer = 1 To snake.Count g.FillRectangle(New SolidBrush(snake(t).KolorWeza), snake(t).rect) Next 'dodaje strukture do kolekcji na 1-wszej pozycji snake.Add(sWaz, , 1) 'jeśli wąż łyknie token If pola(x, y).Location = token.Location Then punkty += 1 'uaktualnia punktację snake.Add(sWaz, , , snake.Count) ' dodaje kawałek ogona na koniec BiezacaDlugoscWeza = snake.Count Timer1.Interval -= 2 'zwiększa szybkość gry If Timer1.Interval < 0 Then Timer1.Interval = 1 GenerujToken() 'generuje nowy token End If 'dodaje niezajęte elementy i token For j As Integer = 0 To wielkoscGry - 1 For i As Integer = 0 To wielkoscGry - 1 If zajetepola(i, j) = False Then g.FillRectangle(kolorPola, pola(i, j)) End If If token = pola(i, j) Then g.FillRectangle(New SolidBrush(Color.Yellow), pola(i, j)) End If Next Next ' ustawia nowy obrazek tła Me.BackgroundImage = podgladgry 'informuje użytkownika o aktualnym poziomie trudności (szybkości) gry i punktacji Me.Text = "Zebrane punkty: " + punkty.ToString + " ,szybkość gry: " + (100 + (((100 - Timer1.Interval) / 100) * 100)).ToString g.Dispose() Refresh() 'wznawia działanie timera Timer1.Enabled = True 'odblokowuje możliwość zmiany kierunku jestemWruchu = False End Sub Private Sub Form1_KeyDown(ByVal sender As System.Object, ByVal e As System.Windows.Forms.KeyEventArgs) Handles MyBase.KeyDown 'Zapobiega auto zderzeniu, gdyby nie było tego ograniczenia moglibyśmy zderzyć się wewnątrz węża 'zanim zmieni się tło formy If jestemWruchu = False Then Select Case e.KeyCode Case Keys.Down 'nie wykona operacji w przeciwnym kierunku która spowoduje wewnętrzne zderzenie elementów If Not (aktKierunek = Kierunek.wDol Or aktKierunek = Kierunek.wGore) Then aktKierunek = Kierunek.wDol jestemWruchu = True End If Case Keys.Left If Not (aktKierunek = Kierunek.wLewo Or aktKierunek = Kierunek.wPrawo) Then aktKierunek = Kierunek.wLewo jestemWruchu = True End If Case Keys.Right If Not (aktKierunek = Kierunek.wPrawo Or aktKierunek = Kierunek.wLewo) Then aktKierunek = Kierunek.wPrawo jestemWruchu = True End If Case Keys.Up If Not (aktKierunek = Kierunek.wGore Or aktKierunek = Kierunek.wDol) Then aktKierunek = Kierunek.wGore jestemWruchu = True End If Case Keys.Space aktKierunek = Kierunek.Pauza End Select End If 'Można usunąć "zajetepola(x, y) = True 'zajmuje nowe pole" w metodzie PoruszWeza() (linia 212) 'po usunięcia ograniczenia da to możliwość zawracania wężowi End Sub Private Sub GenerujToken() Dim rand As New Random Dim x As Integer Dim y As Integer Do x = rand.Next(0, wielkoscGry) y = rand.Next(0, wielkoscGry) If zajetepola(x, y) = False Then Exit Do End If Loop token = pola(x, y) End Sub End Class