Imports System.Drawing.Drawing2D
'così facilito alcun oprazioni di battitura
Public Class MainForm
Dim BitmapGame As New Bitmap(1000, 700)
Dim g As Graphics = Graphics.FromImage(BitmapGame)
'g "avvolge" bitmapgame disegnandole sopra ciò che serve
Dim BallLocation As Point 'posizione della palla
Dim SolidsSurfaces As New List(Of Rectangle) 'superfici solide
Dim Traps As New List(Of Rectangle) 'trappole
Dim ApplicationState As State = State.NotPlayng 'lo stato di gioco
Dim rnd As New Random
Dim level As Byte = 1
Dim score As Integer = 0
Dim lives As Byte = 3
Private Sub RemoveLive()
If lives = 0 Then 'se le vite sono 0 il gioco termina
GameRefresh.Stop()
ApplicationState = State.NotPlayng
If score > 10000 Then 'ma se l'utente ha pù di 10.000 punti il computer regala un'altra possibilità al giocatore (se la vuole) e la dovrà pagare 10.000 punti
If MessageBox.Show("Puoi trasformare 10.000 punti in una vita per continuare a giocare procedere?", Me.Text, MessageBoxButtons.YesNo, MessageBoxIcon.Question) = Windows.Forms.DialogResult.Yes Then
'se l'utente accetta gli si regala una vita e riparte
score -= 10000
lives += 1
SolidsSurfaces.Clear()
Traps.Clear()
SolidsSurfaces.Add(New Rectangle(350, 350, 300, 25))
Traps.Add(New Rectangle(rnd.Next(0, 15) * 50, 450, 300, 25))
SolidsSurfaces.Add(New Rectangle(rnd.Next(0, 15) * 50, 550, 300, 25))
SolidsSurfaces.Add(New Rectangle(rnd.Next(0, 15) * 50, 650, 300, 25))
BallLocation = New Point(425, 300)
Exit Sub
End If
End If
If MessageBox.Show("Hai totalizzato " & score & "punti" & Chr(10) & "Vuoi fare un'altra partita?", Me.Text, MessageBoxButtons.YesNo, MessageBoxIcon.Question) = Windows.Forms.DialogResult.Yes Then
NewGame() 'se l'utente vuole inizia un nuovo gioco
Exit Sub
Else
Application.Exit() 'altrimenti si chiude la finstra
'volendo avrei potuto usare Me.Close, ma Application.Exit interrompe i processi
'e libera le unità di memoria del programma, chiudendolo
End If
Else
lives -= 1 'per chi non lo sapesse "Lives -= 1" = "Lives = Lives - 1"
LblLives.Text = "Vite: " & lives 'viene mostrato all'utente che ha una vita in meno
SolidsSurfaces.Clear() 'vengono cancellate tutte le informazioni di un precedente gioco
Traps.Clear()
SolidsSurfaces.Add(New Rectangle(350, 350, 300, 25))
Traps.Add(New Rectangle(rnd.Next(0, 15) * 50, 450, 300, 25))
SolidsSurfaces.Add(New Rectangle(rnd.Next(0, 15) * 50, 550, 300, 25))
SolidsSurfaces.Add(New Rectangle(rnd.Next(0, 15) * 50, 650, 300, 25))
BallLocation = New Point(425, 300)
End If
End Sub
Private Function IsOnObject(ByVal rect As Rectangle) As objects 'Attenzione: restituisc l'oggetto a contatto con la palla e non sovrapposto
'per trovare l'oggetto a contatto con una superficie solida verifica per tutte queste ultime se
'almeno uno dei due punti del bordo inferiore di rect appartenga al bordo superiore della superfice
'se ciò avviene vuol dire che rect è sopra la superficie
For Each SolidSurface As Rectangle In SolidsSurfaces
If (rect.Y + rect.Height = SolidSurface.Y And (rect.X > SolidSurface.X And rect.X < SolidSurface.X + SolidSurface.Width)) _
Or (rect.Y + rect.Height = SolidSurface.Y And (rect.X + rect.Width > SolidSurface.X And rect.X + rect.Width < SolidSurface.X + SolidSurface.Width)) Then
Return objects.SolidSurface
Exit Function
End If
Next
'altrimenti si va avanti e si verifica lo stesso con le trappole, solo che qui il computer
'concede un leggero margine d'errore
For Each trap As Rectangle In Traps
If (rect.Y + rect.Height = trap.Y And (rect.X - 20 > trap.X And rect.X + 20 < trap.X + trap.Width)) _
Or (rect.Y + rect.Height = trap.Y And (rect.X + rect.Width - 20 > trap.X And rect.X + rect.Width + 20 < trap.X + trap.Width)) Then
'fose vi siete chiesti cosa siano quei +20 e -20, sono il magrine di errore che il computer concede all'utente
Return objects.Trap
Exit Function
End If
Next
'altrimenti se la funzione non si è interrotta prima vuol dire che rect non è a contatto con nulla
Return objects.Null
End Function
Enum State
Playng
Paused
NotPlayng
End Enum
Enum objects
Null
SolidSurface
Trap
End Enum
Private Sub ChangePause() Handles PausaToolStripMenuItem.Click
If ApplicationState = State.Playng Then
PausaToolStripMenuItem.Checked = True
GameRefresh.Stop()
ApplicationState = State.Paused
ElseIf ApplicationState = State.Paused Then
PausaToolStripMenuItem.Checked = False
GameRefresh.Start()
ApplicationState = State.Playng
End If
End Sub 'Cambia lo stato di pausa-non pausa
'se non avete voglia di leggere questa sub vi dico solo che disegna sullo schermo
' alcuni elementi del gioco.
Private Sub Form1_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load
g.SmoothingMode = SmoothingMode.AntiAlias
g.Clear(Color.Azure)
'vine crato lo sfondo azzurro chiaro
Dim pen As New Pen(Color.Black, 4)
Dim brush As New LinearGradientBrush(New PointF(0, 0), New PointF(50, 0), Color.Black, Color.White)
Dim blend As New ColorBlend(3)
blend.Positions = New Single() {0.0, 0.3, 1.0}
blend.Colors = New Color() {Color.Black, Color.Gray, Color.White}
brush.InterpolationColors = blend
'in questo modo si imposta la sfumatura, in questo caso composta da 3 colori
For temp As Integer = 0 To 1000 Step 50 'ovvero ad ogni next temp += 50
g.DrawLines(Pens.DarkGray, New PointF() {New PointF(temp + 12.5, 0), New PointF(temp + 25, 50), New PointF(temp + 37.5, 0)})
g.DrawLines(Pens.DarkGray, New PointF() {New PointF(temp + 12.5, 700), New PointF(temp + 25, 650), New PointF(temp + 37.5, 700)})
'vengono disegnati i bordi segettati in alto e in basso
g.FillPolygon(brush, New PointF() {New PointF(temp + 12.5, 0), New PointF(temp + 25, 50), New PointF(temp + 37.5, 0)})
g.FillPolygon(brush, New PointF() {New PointF(temp + 12.5, 700), New PointF(temp + 25, 650), New PointF(temp + 37.5, 700)})
'vengono quindi riempiti con colori sfunati
Next
g.DrawRectangle(pen, New Rectangle(0, 0, 999, 699))
'viene disegnato un rettanglolo nero intorno all'immagine
g.Flush() 'la classe graphics disegna tutti gli elmenti sulla bitmap
PbxGame.Image = BitmapGame
End Sub
Private Sub PbxGame_KeyDown(ByVal sender As Object, ByVal e As System.Windows.Forms.KeyEventArgs) Handles Me.KeyDown
If ApplicationState = State.Playng Then
Select Case e.KeyCode
Case Keys.Escape
GameRefresh.Stop()
ApplicationState = State.NotPlayng
Application.DoEvents()
If MessageBox.Show("Sei sicuro di voler uscire?", Me.Text, MessageBoxButtons.YesNo, MessageBoxIcon.Question) = Windows.Forms.DialogResult.Yes Then
Application.Exit()
End If
ApplicationState = State.Playng
Case Keys.Left
If Not (BallLocation.X - 10 < 0) Then 'la palla si muove a sinistra solo se si può muovere a sinistra
BallLocation = New Point(BallLocation.X - 10, BallLocation.Y)
End If
Case Keys.Right
If Not (BallLocation.X + 60 > 1000) Then 'la palla si muove a dstra solo se si può muovere a destra
BallLocation = New Point(BallLocation.X + 10, BallLocation.Y)
End If
Case Keys.Up
If Not (BallLocation.X - 10 < 0) Then 'la palla si muove a sinistra solo se si può muovere a sinistra
BallLocation = New Point(BallLocation.X - 10, BallLocation.Y)
End If
Case Keys.Down
If Not (BallLocation.X + 60 > 1000) Then 'la palla si muove a dstra solo se si può muovere a destra
BallLocation = New Point(BallLocation.X + 10, BallLocation.Y)
End If
Case Keys.A
If Not (BallLocation.X - 10 < 0) Then 'la palla si muove a sinistra solo se si può muovere a sinistra
BallLocation = New Point(BallLocation.X - 10, BallLocation.Y)
End If
Case Keys.S
If Not (BallLocation.X + 60 > 1000) Then 'la palla si muove a dstra solo se si può muovere a destra
BallLocation = New Point(BallLocation.X + 10, BallLocation.Y)
End If
Case Keys.P
ChangePause()
End Select
ElseIf ApplicationState = State.Paused Then
If e.KeyCode = Keys.Escape Then ' se l'utente clicca esc gli vine chiesto se vuole uscire
If MessageBox.Show("Sei sicuro di voler uscire?", Me.Text, MessageBoxButtons.YesNo, MessageBoxIcon.Question) = Windows.Forms.DialogResult.Yes Then
Application.Exit()
'se dice di si (quindi non ha cliccato per sbaglio) allora l'applicazione termina
End If
Else
ChangePause()
End If
Else
If e.KeyCode = Keys.Escape Then ' se l'utente clicca esc gli vine chiesto se vuole uscire
If MessageBox.Show("Sei sicuro di voler uscir?", Me.Text, MessageBoxButtons.YesNo, MessageBoxIcon.Question) = Windows.Forms.DialogResult.Yes Then
Application.Exit()
'se dice di si (quindi non ha cliccato per sbaglio) allora l'applicazione termina
End If
Else
NewGame()
End If
End If
End Sub 'importante, serve a permettere all'utente di manovrare la palla
Private Sub GameRefresh_Tick(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles GameRefresh.Tick
g.SmoothingMode = SmoothingMode.AntiAlias
'viene aggiornata l'immagine
Dim pen As New Pen(Color.Black, 4)
Dim brush As New LinearGradientBrush(New PointF(0, 0), New PointF(50, 0), Color.Black, Color.White)
Dim blend As New ColorBlend(3)
blend.Positions = New Single() {0.0, 0.3, 1.0}
blend.Colors = New Color() {Color.Black, Color.Gray, Color.White}
brush.InterpolationColors = blend
'in questo modo si imposta la sfumatura, in questo caso composta da 3 colori
g.Clear(Color.Azure)
'vine crato lo sfondo
'viene disegnata la palla
g.DrawEllipse(Pens.DarkRed, New Rectangle(BallLocation.X, BallLocation.Y, 50, 50))
g.FillEllipse(Brushes.Red, New Rectangle(BallLocation.X, BallLocation.Y, 50, 50))
If BallLocation.Y <= 40 Or BallLocation.Y >= 620 Then
'se la palla è troppo in alto o in basso vuol dire che ha colpito
'o il bordo superiore o quello inferiore quindi viene eliminata una vita
RemoveLive()
Exit Sub
End If
Select Case IsOnObject(New Rectangle(BallLocation.X, BallLocation.Y, 50, 50))
Case objects.SolidSurface
'se sotto la palla c'è una superficie solida la palla vine trascinata in alto da essa.
BallLocation = New Point(BallLocation.X, BallLocation.Y - 5)
Case objects.Trap
'se la palla urta una trappola vine eliminata una vita
RemoveLive()
Exit Sub
Case Else
BallLocation = New Point(BallLocation.X, BallLocation.Y + 15)
'come avrete forse notato la palla cade più velocemente di quanto sale
'inoltre se la palla è "in volo" (in realtà è caduta libera) il computer da un bonus di punti
score = score + 2
End Select
'vengono disegnate le suprfici solide
For index As Integer = 0 To SolidsSurfaces.Count - 1
g.DrawRectangle(New Pen(Color.DarkBlue, 2), SolidsSurfaces(index))
g.FillRectangle(Brushes.Blue, SolidsSurfaces(index))
SolidsSurfaces(index) = New Rectangle(SolidsSurfaces(index).X, SolidsSurfaces(index).Y - 5, SolidsSurfaces(index).Width, SolidsSurfaces(index).Height)
Next
'e le trappole
For index As Integer = 0 To Traps.Count - 1
For temp As Integer = Traps(index).X To Traps(index).X + Traps(index).Width - 50 Step 50 'ovvero ad ogni next temp += 50
g.DrawLines(Pens.DarkGray, New PointF() {New PointF(temp + 12.5, Traps(index).Y + Traps(index).Height), New PointF(temp + 25, Traps(index).Y + Traps(index).Height - 50), New PointF(temp + 37.5, Traps(index).Y + Traps(index).Height)})
'vengono disegnati i bordi segettati in alto
g.FillPolygon(brush, New PointF() {New PointF(temp + 12.5, Traps(index).Y + Traps(index).Height), New PointF(temp + 25, Traps(index).Y + Traps(index).Height - 50), New PointF(temp + 37.5, Traps(index).Y + Traps(index).Height)})
'vengono quindi riempiti con colori sfunati
Next
g.DrawLine(New Pen(Color.Brown, 6), Traps(index).X, Traps(index).Y + Traps(index).Height, Traps(index).X + Traps(index).Width, Traps(index).Y + Traps(index).Height)
'infine sotto viene disegnata una linea marrone per coprire la parte inferiore dei triangoli disegnati sopra
Traps(index) = New Rectangle(Traps(index).X, Traps(index).Y - 5, Traps(index).Width, Traps(index).Height)
Next
'la superficie 0 è quella più in alto quindi sarà la prima ad essere distrutta, quando ciò
'avvinene la superficie subito sotto sarà la superficie 0 e si riparte da capo
'le superfici sono ordinate in alto quelle con indice minore e in basso quelle con indice maggiore
'per verificare meglio il funzionamento di cio inserite questo codice nel for precedente
'e fate partire l'applicazione, i numerini indicheranno l'indice di ogni rettangolo
'g.DrawString(index, Me.Font, Brushes.Black, SolidsSurfaces(index).X, SolidsSurfaces(index).Y)
If SolidsSurfaces(0).Location.Y = (-25) Then
'quando una superficie raggiunge questa posizione non si vede più, quindi la si elimina
'per liberare memoria
SolidsSurfaces.RemoveAt(0)
End If
'lo stesso vale per le trappole
If Traps(0).Location.Y = (-25) Then
Traps.RemoveAt(0)
End If
'essendo ordinate quella con maggiore indice dovrebbe essere più in basso, quindi se se ne deve
'creare un'altra ci si baserà sulla posizione di quella.
'lo stesso vale per le trappole
If SolidsSurfaces(SolidsSurfaces.Count - 1).Y = 600 Or Traps(Traps.Count - 1).Y = 600 Then
'il computer deve generare nuove superfici altrimenti la pallina cadrebbe
'quando la superficie più in basso ha come coordinata y 600 è abbastanza in alto per
'permettere la creazione di una nuova superficie
'il computer manterrà sullo schermo sempre una trappola
If Traps.Count = 1 Then
Traps.Add(New Rectangle(rnd.Next(0, 15) * 50, 700, 300, 25))
Else
SolidsSurfaces.Add(New Rectangle(rnd.Next(0, 15) * 50, 700, 300, 25))
End If
End If
For temp As Integer = 0 To 950 Step 50 'ovvero ad ogni next temp += 50
g.DrawLines(Pens.DarkGray, New PointF() {New PointF(temp + 12.5, 0), New PointF(temp + 25, 50), New PointF(temp + 37.5, 0)})
g.DrawLines(Pens.DarkGray, New PointF() {New PointF(temp + 12.5, 700), New PointF(temp + 25, 650), New PointF(temp + 37.5, 700)})
'vengono disegnati i bordi segettati in alto e in basso
g.FillPolygon(brush, New PointF() {New PointF(temp + 12.5, 0), New PointF(temp + 25, 50), New PointF(temp + 37.5, 0)})
g.FillPolygon(brush, New PointF() {New PointF(temp + 12.5, 700), New PointF(temp + 25, 650), New PointF(temp + 37.5, 700)})
'vengono quindi riempiti con colori sfunati
Next
g.DrawRectangle(pen, New Rectangle(0, 0, 999, 699))
'viene disegnato un rettanglolo nero intorno all'immagine
g.Flush() 'la classe graphics disegna tutti gli elmenti sulla bitmap
PbxGame.Image = BitmapGame
score += 2 'Vengono aggiunti due punti
LblScore.Text = "Punti: " & score
End Sub
Private Sub NewGame() Handles NuovaPartitaToolStripMenuItem.Click
SolidsSurfaces.Clear() 'vengono cancellate tutte le informazioni di un precedente gioco
Traps.Clear()
SolidsSurfaces.Add(New Rectangle(350, 350, 300, 25))
Traps.Add(New Rectangle(rnd.Next(0, 15) * 50, 450, 300, 25))
SolidsSurfaces.Add(New Rectangle(rnd.Next(0, 15) * 50, 550, 300, 25))
SolidsSurfaces.Add(New Rectangle(rnd.Next(0, 15) * 50, 650, 300, 25))
score = 0
LblScore.Text = "Punti: 0"
lives = 3
LblLives.Text = "Vite: 3"
LblLevel.Text = "Livello: " & level
GameRefresh.Interval = 25 * (6 - level) 'in base al livello si sceglie la velocità .
BallLocation = New Point(425, 300)
PausaToolStripMenuItem.Checked = False
GameRefresh.Start()
ApplicationState = State.Playng
End Sub
Private Sub ToolStripMenuItem1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles ToolStripMenuItem1.Click
ToolStripMenuItem2.Checked = False
ToolStripMenuItem3.Checked = False
ToolStripMenuItem4.Checked = False
ToolStripMenuItem5.Checked = False
level = 1
End Sub
Private Sub ToolStripMenuItem2_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles ToolStripMenuItem2.Click
ToolStripMenuItem1.Checked = False
ToolStripMenuItem3.Checked = False
ToolStripMenuItem4.Checked = False
ToolStripMenuItem5.Checked = False
level = 2
End Sub
Private Sub ToolStripMenuItem3_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles ToolStripMenuItem3.Click
ToolStripMenuItem1.Checked = False
ToolStripMenuItem2.Checked = False
ToolStripMenuItem4.Checked = False
ToolStripMenuItem5.Checked = False
level = 3
End Sub
Private Sub ToolStripMenuItem4_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles ToolStripMenuItem4.Click
ToolStripMenuItem1.Checked = False
ToolStripMenuItem2.Checked = False
ToolStripMenuItem3.Checked = False
ToolStripMenuItem5.Checked = False
level = 4
End Sub
Private Sub ToolStripMenuItem5_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles ToolStripMenuItem5.Click
ToolStripMenuItem1.Checked = False
ToolStripMenuItem2.Checked = False
ToolStripMenuItem3.Checked = False
ToolStripMenuItem4.Checked = False
level = 5
End Sub
Private Sub EsciToolStripMenuItem_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles EsciToolStripMenuItem.Click
Application.Exit()
End Sub
End Class
'Breve spiegazione del funzionamento del gioco, se volete capirlo in dettaglio leggete il codice
'inizio: creare superficie al centro con sopra palla.
'Il timer serve a aggiornare la finestra di gioco dopo un tot di tempo
'ciò che appare sullo schermo è la rappresentazione grafica delle
'variabili dichiarate all'inizio, quindi se quelle cambiano l'immagine sullo
'schermo cambierà al suo nuovo aggiornamento
'la difficoltà del gioco è direttamente proporzionale all'itervallo di tempo fra 2 tick consecutivi del timer
