Imports System.IO
Imports System.Threading
Imports System.Drawing
Imports System.Drawing.Drawing2D
'***************************************************************************
'Gioco del 2048 realizzato da *** Tebaldo Ulleri *** in Data 12-Aprile-2018
'***************************************************************************
'Developers: Tebaldo Ulleri, Carlo Barabucci, Michele Cannavo
'***************************************************************************
Public Class Form1
'***********************************************************************
'Variabili globali
Public TipoGrafica As Short = My.Settings.Immagini_Set ' 1 grafica default 2 grafica nuova
Public InMovimento As Boolean
Public Tempo As Date ' data e ora
Public Partenza As Date = DateTime.Now ' data e ora di inizio gioco
Public AutoOn As Boolean = False
Public Move_R As Boolean
Public Move_L As Boolean
Public Move_U As Boolean
Public Move_D As Boolean
Public Mosse_Auto As Boolean
Public Audio_On As Boolean
Public Animazione_On As Boolean
Public Mat4x4Pict_2040() As PictureBox = {}
Public Matrice4x4(4, 4) As Integer
Public Matrice_Back1(4, 4) As Integer
Public Potenze_del_2() As Int32 = {2, 4, 8, 16, 32, 64, 128, 256, 512, 1024, 2048, 4096, 8192}
Public Stato_eventi As Int32
Public Punteggio As Int32
Public mosse As Int32
Public Record As Int32
Public Giocatore As String
Public Indx_Nuovo_Val As String
Public Max_Potenza_Raggiunta As Int32
Public Ultima_Potenza As Int32
Public Nuovo_Record As Boolean
Public Scambio_ok As Boolean
Public Scambio_ok_Back As Boolean
Public Obiettivi_Punteggio() As Int32 = {2048, 4096, 8192}
Public Scelta_Colori As New List(Of Color)
' Suono1.
Dim Suono1 = New System.Media.SoundPlayer("C:\Windows\Media\chord.wav")
' Suono2.
Dim Suono2 = New System.Media.SoundPlayer("C:\Windows\Media\tada.wav")
' Suono3.
Dim Suono3 = New System.Media.SoundPlayer("C:\Windows\Media\notify.wav")
' Suono4.
' Inserire in Resources una musica di tipo WAV e richiamarla quà sotto in My.Resources........
Dim Suono4 = New System.Media.SoundPlayer(My.Resources.win)
' Suono5.
' Inserire in Resources una musica di tipo WAV e richiamarla quà sotto in My.Resources........
Dim Suono5 = New System.Media.SoundPlayer(My.Resources.VGOMyMove)
'***********************************************************************
Sub New()
' Chiamata richiesta dalla finestra di progettazione.
InitializeComponent()
' Aggiungere le eventuali istruzioni di inizializzazione dopo la chiamata a InitializeComponent().
Me.Animazione1ToolStrip.Checked = My.Settings.Animazione_1
Me.Animazione2ToolStrip.Checked = My.Settings.Animazione_2
Me.Animazione3ToolStrip.Checked = My.Settings.Animazione_3
' se no settings (primo uso del programma), carico dati di default
If TipoGrafica <> 1 _
And TipoGrafica <> 2 _
And TipoGrafica <> 3 _
And TipoGrafica <> 4 _
And TipoGrafica <> 5 _
And TipoGrafica <> 6 _
And TipoGrafica <> 7 _
And TipoGrafica <> 8 _
Then TipoGrafica = 1
If Me.Animazione1ToolStrip.Checked = False _
And Me.Animazione2ToolStrip.Checked = False _
And Me.Animazione3ToolStrip.Checked = False _
Then Me.Animazione1ToolStrip.Checked = True
Animazione_On = True
Audio_On = True
Scelta_Colori.Add(Color.Blue) 'index 0
Scelta_Colori.Add(Color.Bisque)
Scelta_Colori.Add(Color.DarkGray)
Scelta_Colori.Add(Color.DarkKhaki)
Scelta_Colori.Add(Color.Brown)
Scelta_Colori.Add(Color.Brown)
Scelta_Colori.Add(Color.DarkGreen)
Scelta_Colori.Add(Color.Navy)
Scelta_Colori.Add(Color.Navy) 'index 8
End Sub
Private Sub Form1_2048_Game_Load(sender As Object, e As EventArgs) Handles Me.Load
Nuovo_Record = False
Scambio_ok = True
Scambio_ok_Back = True
Mosse_Auto = True
Move_R = False
Move_L = False
Move_U = False
Move_D = False
Call Crea_Simboli(TipoGrafica)
Call Inizializza_Matrice2048(Matrice4x4)
Stato_eventi = Stato.Azzerato
Call CreaSchema4X4Classic2048()
Call Random_Matrice4x4_2048()
Call Visualizza_Immagine_Celle2048(Matrice4x4)
Call Copia_Matrice2048(Matrice4x4, Matrice_Back1)
Me.Text &= " v.8.9.9 "
Me.TextBox_Nome.BackColor = Color.Yellow
InMovimento = False
End Sub
Enum Stato
Azzerato 'index 0
Avviato
Completato
Errato 'index 3
End Enum
'Disegna lo schema 4 x 4 del gioco
Public Sub CreaSchema4X4Classic2048()
Panel1.Controls.Clear()
ReDim Mat4x4Pict_2040(16)
Dim xP, yP, nCel, size_c As Integer
yP = 12
nCel = 0
size_c = 84
For i As Int32 = 1 To 4 Step +1
xP = 13
For j As Int32 = 1 To 4 Step +1
nCel += 1
Mat4x4Pict_2040(nCel) = New PictureBox
Mat4x4Pict_2040(nCel).AutoSize = False
Mat4x4Pict_2040(nCel).Font = New System.Drawing.Font("Arial", 12, FontStyle.Bold)
Mat4x4Pict_2040(nCel).Size = New System.Drawing.Size(size_c, size_c)
Mat4x4Pict_2040(nCel).Location = New System.Drawing.Point(xP, yP)
Mat4x4Pict_2040(nCel).BackColor = Scelta_Colori(TipoGrafica)
Mat4x4Pict_2040(nCel).ForeColor = Color.Maroon
Mat4x4Pict_2040(nCel).Name = "Cella_" & i.ToString & "-" & j.ToString
Mat4x4Pict_2040(nCel).Text = j.ToString
Mat4x4Pict_2040(nCel).Tag = (i).ToString & "-" & (j).ToString
Mat4x4Pict_2040(nCel).BackgroundImageLayout = ImageLayout.Center
Panel1.Controls.Add(Mat4x4Pict_2040(nCel))
xP = xP + (size_c + 2)
Next j
yP = yP + (size_c + 2)
Next i
End Sub
Public Function Consenso_Mosse(ByRef Matr2048 As Int32(,), ByVal Direz As String) As Boolean
Dim consenso As Boolean = False
Select Case Direz
Case Is = "U"
For c As Int32 = 1 To 3
For r As Int32 = 4 To 1 Step -1
If Matr2048(c, r) = Matr2048(c + 1, r) And Matr2048(c, r) > 1 Then
consenso = True
End If
If Matr2048(c, r) = 1 And Matr2048(c + 1, r) > 1 Then
consenso = True
End If
Next r
Next c
Case Is = "L"
For R = 1 To 4
For C = 1 To 3
If Matr2048(R, C) = Matr2048(R, C + 1) And Matr2048(R, C) > 1 Then
consenso = True
End If
If Matr2048(R, C) = 1 And Matr2048(R, C + 1) > 1 Then
consenso = True
End If
Next C
Next R
Case Is = "D"
For c As Int32 = 4 To 2 Step -1
For r As Int32 = 1 To 4
If Matr2048(c, r) = 1 And Matr2048(c - 1, r) > 1 Then
consenso = True
End If
If Matr2048(c, r) = Matr2048(c - 1, r) And Matr2048(c, r) > 1 Then
consenso = True
End If
Next r
Next c
Case Is = "R"
For r As Int32 = 1 To 4
For c As Int32 = 4 To 2 Step -1
If Matr2048(r, c) = 1 And Matr2048(r, c - 1) > 1 Then
consenso = True
End If
If Matr2048(r, c) = Matr2048(r, c - 1) And Matr2048(r, c) > 1 Then
consenso = True
End If
Next c
Next r
End Select
Return consenso
End Function
Private Sub But_UP_Click(sender As Object, e As EventArgs) Handles But_UP.Click
If InMovimento Then Exit Sub ' se l'animazione è in corso non eseguo
Move_U = Consenso_Mosse(Matrice4x4, "U")
If Move_U = True Then
Call Copia_Matrice2048(Matrice4x4, Matrice_Back1)
Scambio_ok_Back = Scambio_ok
End If
Scambio_ok = False
Call Elabora_Matrice4x4_UP(Matrice4x4)
If Scambio_ok = True Then
Call Random_Matrice4x4_2048()
InMovimento = True ' evita errore
Call Visualizza_Immagine_Celle2048(Matrice4x4)
InMovimento = False ' evita errore
Else
Call verifica_Mosse(Matrice4x4)
End If
Call cambia_colore_P(sender)
End Sub
Private Sub But_Down_Click(sender As Object, e As EventArgs) Handles But_Down.Click
If InMovimento Then Exit Sub ' se l'animazione è in corso non eseguo
Move_D = Consenso_Mosse(Matrice4x4, "D")
If Move_D = True Then
Call Copia_Matrice2048(Matrice4x4, Matrice_Back1)
Scambio_ok_Back = Scambio_ok
End If
Scambio_ok = False
Call Elabora_Matrice4x4_Down(Matrice4x4)
If Scambio_ok = True Then
Call Random_Matrice4x4_2048()
InMovimento = True ' evita errore
Call Visualizza_Immagine_Celle2048(Matrice4x4)
InMovimento = False ' evita errore
Else
Call verifica_Mosse(Matrice4x4)
End If
Call cambia_colore_P(sender)
End Sub
Private Sub But_R_Click(sender As Object, e As EventArgs) Handles But_R.Click
If InMovimento Then Exit Sub ' se l'animazione è in corso non eseguo
Move_R = Consenso_Mosse(Matrice4x4, "R")
If Move_R = True Then
Call Copia_Matrice2048(Matrice4x4, Matrice_Back1)
Scambio_ok_Back = Scambio_ok
End If
Scambio_ok = False
Call Elabora_Matrice4x4_Right(Matrice4x4)
If Scambio_ok = True Then
Call Random_Matrice4x4_2048()
InMovimento = True ' evita errore
Call Visualizza_Immagine_Celle2048(Matrice4x4)
InMovimento = False ' evita errore
Else
Call verifica_Mosse(Matrice4x4)
End If
Call cambia_colore_P(sender)
End Sub
Private Sub But_L_Click(sender As Object, e As EventArgs) Handles But_L.Click
If InMovimento Then Exit Sub ' se l'animazione è in corso non eseguo
Move_L = Consenso_Mosse(Matrice4x4, "L")
If Move_L = True Then
Call Copia_Matrice2048(Matrice4x4, Matrice_Back1)
Scambio_ok_Back = Scambio_ok
End If
Scambio_ok = False
Call Elabora_Matrice4x4_Left(Matrice4x4)
If Scambio_ok = True Then
Call Random_Matrice4x4_2048()
InMovimento = True ' evita errore
Call Visualizza_Immagine_Celle2048(Matrice4x4)
InMovimento = False ' evita errore
Else
Call verifica_Mosse(Matrice4x4)
End If
Call cambia_colore_P(sender)
End Sub
Private Sub Back1PassoToolStrip_Click(sender As Object, e As EventArgs) Handles Back1PassoToolStrip.Click
Call Copia_Matrice2048(Matrice_Back1, Matrice4x4)
Call Visualizza_Immagine_Celle2048(Matrice4x4)
Scambio_ok = Scambio_ok_Back
mosse -= 1
InMovimento = False ' evita errore
End Sub
'Funzione per i comandi da tastiera inserita dal Dev. Carlo
Protected Overrides Function ProcessCmdKey(ByRef msg As Message, ByVal keyData As Keys) As Boolean
If InMovimento = True Then
Return True
End If
' Intercetto le frecce
Select Case keyData
Case Keys.Down
But_Down.Focus()
But_Down_Click(But_Down, New System.EventArgs())
Case Keys.Up
But_UP.Focus()
But_UP_Click(But_UP, New System.EventArgs())
Case Keys.Left
But_L.Focus()
But_L_Click(But_L, New System.EventArgs())
Case Keys.Right
But_R.Focus()
But_R_Click(But_R, New System.EventArgs())
Case Keys.D0
AzzeraToolStripMenuItem_Click(0, New System.EventArgs())
Case Keys.Escape
EsciToolStripMenuItem_Click(0, New System.EventArgs())
Case Keys.Z
Back1PassoToolStrip_Click(0, New System.EventArgs())
Case Keys.V
Call VisualizzaTest() ' mostra i simboli correnti
Case Keys.H
Animazione1ToolStrip_Click(0, New System.EventArgs())
Case Keys.J
Animazione2ToolStrip_Click(0, New System.EventArgs())
Case Keys.K
Animazione3ToolStrip_Click(0, New System.EventArgs())
Case Keys.D1
ImmaginiSet1ToolStrip_Click(0, New System.EventArgs())
Case Keys.D2
ImmaginiSet2ToolStrip_Click(0, New System.EventArgs())
Case Keys.D3
ImmaginiSet3ToolStrip_Click(0, New System.EventArgs())
Case Keys.D4
ImmaginiSet4ToolStrip_Click(0, New System.EventArgs())
Case Keys.D5
ImmaginiSet5ToolStrip_Click(0, New System.EventArgs())
Case Keys.D6
ImmaginiSet6ToolStrip_Click(0, New System.EventArgs())
Case Keys.D7
ImmaginiSet7ToolStrip_Click(0, New System.EventArgs())
Case Keys.D8
ImmaginiSet8ToolStrip_Click(0, New System.EventArgs())
End Select
keyData = Nothing
Return True
End Function
'Funzione per i comandi Touch
Private Sub Touch_Input(ByVal sender As System.Object, ByVal e As System.EventArgs)
If (Me.Panel1 IsNot Nothing) Then
End If
End Sub
Public Sub cambia_colore_P(ByVal sender As Object)
Dim nome_P As String = sender.tag
Me.But_L.BackColor = Color.White
Me.But_R.BackColor = Color.White
Me.But_UP.BackColor = Color.White
Me.But_Down.BackColor = Color.White
Select Case nome_P
Case Is = "L"
Me.But_L.BackColor = Color.DarkOliveGreen
Case Is = "R"
Me.But_R.BackColor = Color.DarkOliveGreen
Case Is = "U"
Me.But_UP.BackColor = Color.DarkOliveGreen
Case Is = "D"
Me.But_Down.BackColor = Color.DarkOliveGreen
End Select
mosse += 1
End Sub
Public Sub Verifica_Ultima_Potenza(ByVal P As Int32)
If Audio_On Then Thread.Sleep(200)
Ultima_Potenza = P
If Ultima_Potenza > Max_Potenza_Raggiunta Then Max_Potenza_Raggiunta = Ultima_Potenza Else Return
Dim index As Int32 = Array.IndexOf(Obiettivi_Punteggio, Max_Potenza_Raggiunta)
If index >= 0 Then
Suono4.play()
Obiettivi_Punteggio(index) = 0
End If
End Sub
Public Sub Elabora_Matrice4x4_Down(ByRef Matr2048 As Int32(,))
Dim Ripeti As Int32 = 0
Scambio_ok = False
While Ripeti < NumericUpDown1.Value
For c As Int32 = 4 To 2 Step -1
For r As Int32 = 1 To 4
If Matr2048(c, r) = 1 And Matr2048(c - 1, r) > 1 Then
Matr2048(c, r) = Matr2048(c - 1, r)
Matr2048(c - 1, r) = 1
Scambio_ok = True
End If
If Ripeti = 0 Or Ripeti = 2 Then
If Matr2048(c, r) = Matr2048(c - 1, r) And Matr2048(c, r) > 1 Then
Matr2048(c, r) *= 2
Matr2048(c - 1, r) = 1
Punteggio += Matr2048(c, r)
Scambio_ok = True
If Audio_On Then Suono5.play()
Call Verifica_Ultima_Potenza(Matr2048(c, r))
End If
End If
If Matr2048(c, r) = 1 And Matr2048(c - 1, r) > 1 Then
Matr2048(c, r) = Matr2048(c - 1, r)
Matr2048(c - 1, r) = 1
Scambio_ok = True
End If
Next r
Next c
Ripeti += 1
End While
Ripeti = 1
While Ripeti = 1
Ripeti = 0
For c As Int32 = 4 To 2 Step -1
For r As Int32 = 1 To 4
If Matr2048(c, r) = 1 And Matr2048(c - 1, r) > 1 Then
Matr2048(c, r) = Matr2048(c - 1, r)
Matr2048(c - 1, r) = 1
Ripeti = 1
Scambio_ok = True
End If
Next r
Next c
End While
End Sub
Public Sub Elabora_Matrice4x4_UP(ByRef Matr2048 As Int32(,))
Dim Ripeti As Int32 = 0
Scambio_ok = False
While Ripeti < NumericUpDown1.Value
For c As Int32 = 1 To 3
For r As Int32 = 4 To 1 Step -1
If Matr2048(c, r) = 1 And Matr2048(c + 1, r) > 1 Then
Matr2048(c, r) = Matr2048(c + 1, r)
Matr2048(c + 1, r) = 1
Scambio_ok = True
End If
If Ripeti = 0 Or Ripeti = 2 Then
If Matr2048(c, r) = Matr2048(c + 1, r) And Matr2048(c, r) > 1 Then
Matr2048(c, r) *= 2
Matr2048(c + 1, r) = 1
Punteggio += Matr2048(c, r)
Scambio_ok = True
If Audio_On Then Suono5.play()
Call Verifica_Ultima_Potenza(Matr2048(c, r))
End If
End If
If Matr2048(c, r) = 1 And Matr2048(c + 1, r) > 1 Then
Matr2048(c, r) = Matr2048(c + 1, r)
Matr2048(c + 1, r) = 1
Scambio_ok = True
End If
Next r
Next c
Ripeti += 1
End While
Ripeti = 1
While Ripeti = 1
Ripeti = 0
For c As Int32 = 1 To 3
For r As Int32 = 4 To 1 Step -1
If Matr2048(c, r) = 1 And Matr2048(c + 1, r) > 1 Then
Matr2048(c, r) = Matr2048(c + 1, r)
Matr2048(c + 1, r) = 1
Ripeti = 1
Scambio_ok = True
End If
Next r
Next c
End While
End Sub
Public Sub Elabora_Matrice4x4_Left(ByRef Matr2048 As Int32(,))
Dim Ripeti As Int32 = 0
Scambio_ok = False
While Ripeti < NumericUpDown1.Value
For r As Int32 = 1 To 4
For c As Int32 = 1 To 3
If Matr2048(r, c) = 1 And Matr2048(r, c + 1) > 1 Then
Matr2048(r, c) = Matr2048(r, c + 1)
Matr2048(r, c + 1) = 1
Scambio_ok = True
End If
If Ripeti = 0 Or Ripeti = 2 Then
If Matr2048(r, c) = Matr2048(r, c + 1) And Matr2048(r, c) > 1 Then
Matr2048(r, c) *= 2
Matr2048(r, c + 1) = 1
Punteggio += Matr2048(r, c)
Scambio_ok = True
If Audio_On Then Suono5.play()
Call Verifica_Ultima_Potenza(Matr2048(r, c))
End If
End If
If Matr2048(r, c) = 1 And Matr2048(r, c + 1) > 1 Then
Matr2048(r, c) = Matr2048(r, c + 1)
Matr2048(r, c + 1) = 1
Scambio_ok = True
End If
Next c
Next r
Ripeti += 1
End While
Ripeti = 1
While Ripeti = 1
Ripeti = 0
For r As Int32 = 1 To 4
For c As Int32 = 1 To 3
If Matr2048(r, c) = 1 And Matr2048(r, c + 1) > 1 Then
Matr2048(r, c) = Matr2048(r, c + 1)
Matr2048(r, c + 1) = 1
Ripeti = 1
Scambio_ok = True
End If
Next c
Next r
End While
End Sub
Public Sub Elabora_Matrice4x4_Right(ByRef Matr2048 As Int32(,))
Dim Ripeti As Int32 = 0
Scambio_ok = False
While Ripeti < NumericUpDown1.Value
For r As Int32 = 1 To 4
For c As Int32 = 4 To 2 Step -1
If Matr2048(r, c) = 1 And Matr2048(r, c - 1) > 1 Then
Matr2048(r, c) = Matr2048(r, c - 1)
Matr2048(r, c - 1) = 1
Scambio_ok = True
End If
If Ripeti = 0 Or Ripeti = 2 Then
If Matr2048(r, c) = Matr2048(r, c - 1) And Matr2048(r, c) > 1 Then
Matr2048(r, c) *= 2
Matr2048(r, c - 1) = 1
Punteggio += Matr2048(r, c)
Scambio_ok = True
If Audio_On Then Suono5.play()
Call Verifica_Ultima_Potenza(Matr2048(r, c))
End If
End If
If Matr2048(r, c) = 1 And Matr2048(r, c - 1) > 1 Then
Matr2048(r, c) = Matr2048(r, c - 1)
Matr2048(r, c - 1) = 1
Scambio_ok = True
End If
Next c
Next r
Ripeti += 1
End While
Ripeti = 1
While Ripeti = 1
Ripeti = 0
For r As Int32 = 1 To 4
For c As Int32 = 4 To 2 Step -1
If Matr2048(r, c) = 1 And Matr2048(r, c - 1) > 1 Then
Matr2048(r, c) = Matr2048(r, c - 1)
Matr2048(r, c - 1) = 1
Ripeti = 1
Scambio_ok = True
End If
Next c
Next r
End While
End Sub
Public Sub Inizializza_Matrice2048(ByRef Matr2048 As Int32(,))
For r As Int32 = 1 To 4
For c As Int32 = 1 To 4
Matr2048(r, c) = 1
Next c
Next r
End Sub
Public Sub Copia_Matrice2048(ByRef Matr2048 As Int32(,), ByRef CopiaMatrice As Int32(,))
'clona la matrice base
Array.Copy(Matr2048, CopiaMatrice, 25)
End Sub
Public Sub verifica_Mosse(ByRef Matr2048 As Int32(,))
'verifica che ci siano mosse possibili
Dim flag As Boolean = False
For R = 1 To 4
For C = 1 To 4
If Matr2048(R, C) = 1 Then
flag = True
End If
Next C
Next R
For R = 1 To 4
For C = 1 To 3
If Matr2048(R, C) = Matr2048(R, C + 1) Then
flag = True
End If
Next C
Next R
For c As Int32 = 1 To 3
For r As Int32 = 4 To 1 Step -1
If Matr2048(c, r) = Matr2048(c + 1, r) Then
flag = True
End If
Next r
Next c
If flag = False And AutoOn = False Then
If Audio_On Then Thread.Sleep(100)
If Audio_On Then Suono1.play()
MsgBox(" Non ci sono coppie possibili, Cambia pulsante o Ritenta ")
Exit Sub
End If
If flag = False And AutoOn = True Then
Mosse_Auto = False
End If
If Scambio_ok = False And AutoOn = True And flag = True Then
Mosse_Auto = False
End If
If Scambio_ok = False And AutoOn = True And flag = False Then
AutoOn = False
End If
End Sub
Public Sub Random_Matrice4x4_2048()
If Stato_eventi = Stato.Azzerato Then
Stato_eventi = Stato.Avviato
Estrai()
'Ricorsiva
Random_Matrice4x4_2048()
Else
Estrai()
End If
End Sub
Public Sub Estrai()
Dim rand As New Random
Dim R As Int32
Dim C As Int32
Do
R = rand.Next(1, 5)
C = rand.Next(1, 5)
If Matrice4x4(R, C) = 1 Then
Matrice4x4(R, C) = Rand_2_4()
Indx_Nuovo_Val = R & "-" & C
Verifica_Ultima_Potenza(Matrice4x4(R, C))
Exit Do
End If
Loop
End Sub
Public Function Rand_2_4() As Int32
Dim rand As New Random
Dim num As Int32
Dim opz() As Int32 = {2, 2, 2, 2, 4}
num = opz(rand.Next(0, 5))
Return num
End Function
Public Sub Animazione_Pbx(ByRef Pbx As PictureBox)
'Movimento animato di una PictureBox.
InMovimento = True ' evita errore
If Pbx Is Nothing Then
Exit Sub
End If
Me.Refresh()
If Me.Animazione2ToolStrip.Checked = True Then
Pbx.BringToFront()
Dim Location_Pbx As Point
Dim vn1 As Int32 = 3
Dim vn2 As Int32 = 1
For j As Int32 = 1 To 5
Pbx.Width -= vn1
Pbx.Height -= vn1
Thread.Sleep(1)
Location_Pbx = New Point(Pbx.Left + vn2, Pbx.Top + vn2)
Pbx.Location = Location_Pbx
Next j
For i As Int32 = 1 To 5
Pbx.Width += vn1
Pbx.Height += vn1
Thread.Sleep(50)
Location_Pbx = New Point(Pbx.Left - vn2, Pbx.Top - vn2)
Pbx.Location = Location_Pbx
Pbx.Refresh()
Next i
ElseIf Me.Animazione1ToolStrip.Checked = True Then
Dim Immagine As Bitmap = Pbx.Image
Pbx.Image = Nothing
Pbx.Refresh()
For i = -84 To 0
Using PbxGraphics As Graphics = Pbx.CreateGraphics()
PbxGraphics.DrawImage(Immagine, 0, i, 84, 84)
End Using
Thread.Sleep(2)
Next i
Pbx.Image = Immagine
Pbx.Refresh()
ElseIf Me.Animazione3ToolStrip.Checked = True Then
Dim Immagine As Bitmap = Pbx.Image
Pbx.Image = Nothing
Pbx.Refresh()
For i = 0 To 84
Using PbxGraphics As Graphics = Pbx.CreateGraphics()
PbxGraphics.DrawImage(Immagine, 42 - i \ 2, 42 - i \ 2, i, i)
End Using
Thread.Sleep(2)
Next i
Pbx.Image = Immagine
Pbx.Refresh()
End If
End Sub
Public Sub Visualizza_Immagine_Celle2048(ByRef Matr2048 As Int32(,))
'indice della cella nuovo valore random
Dim invr As Int32
For i As Int32 = 1 To 16
Dim Tag_Cella As String = ""
Tag_Cella = Mat4x4Pict_2040(i).Tag
For r As Int32 = 1 To 4
For c As Int32 = 1 To 4
Dim index_M As String = r & "-" & c
If index_M = Tag_Cella Then
'** Inserisce le rispettive immagini **
If Matr2048(r, c) = 1 Then
Mat4x4Pict_2040(i).Image = Nothing
Else
Mat4x4Pict_2040(i).Image = Me.ImageList1.Images(CInt(Math.Log(Matr2048(r, c), 2)) - 1)
If index_M = Indx_Nuovo_Val Then
invr = i
End If
End If
'************************
End If
Next c
Next r
Next i
'** Inserimento immagine corrispondente **
If Max_Potenza_Raggiunta > 1 Then
Me.PictureBox1.BackgroundImage = Me.ImageList1.Images(CInt(Math.Log(Max_Potenza_Raggiunta, 2)) - 1)
End If
'************************
'Avvio la procedura di animazione
If Animazione_On Then Call Animazione_Pbx(Mat4x4Pict_2040(invr))
Dim new_record As Int32
new_record = Punteggio - (CInt(My.Settings.Record))
If new_record > 0 Then
Giocatore = TextBox_Nome.Text
My.Settings.Record = Punteggio
My.Settings.Mosse_Rec = mosse
My.Settings.Nome = Giocatore
My.Settings.Max_Valore = Max_Potenza_Raggiunta
My.Settings.Save()
If Audio_On Then Thread.Sleep(200)
If Nuovo_Record = False Then
Nuovo_Record = True
If Audio_On Then Suono2.play()
Label1.ForeColor = Color.Red
End If
End If
Label1.Text = "Punteggio Record: " & My.Settings.Record
Label2.Text = "Mosse: " & My.Settings.Mosse_Rec
Label3.Text = "Record di: " & My.Settings.Nome
Label4.Text = "Max_Val: " & My.Settings.Max_Valore
Me.TSLabel_Stato.Text = "Stato: Punteggio " & Punteggio & " Mosse " & mosse
Me.Refresh()
End Sub
Private Sub AzzeraToolStripMenuItem_Click(sender As Object, e As EventArgs) Handles AzzeraToolStripMenuItem.Click
Stato_eventi = Stato.Azzerato
Punteggio = 0
mosse = 0
Max_Potenza_Raggiunta = 2
Obiettivi_Punteggio = {2048, 4096, 8192} ' ripristino
Call Inizializza_Matrice2048(Matrice4x4)
Call Random_Matrice4x4_2048()
Call Visualizza_Immagine_Celle2048(Matrice4x4)
Scambio_ok = True
InMovimento = False
End Sub
Private Sub EsciToolStripMenuItem_Click(sender As Object, e As EventArgs) Handles EsciToolStripMenuItem.Click
My.Settings.Save()
End
End Sub
Private Sub TextBox_Nome_Click(sender As Object, e As EventArgs) Handles TextBox_Nome.Click
'inserimento nome giocatore
Me.Enabled = False
LoginForm1.Show()
End Sub
Private Sub Timer1_Tick(ByVal eventSender As System.Object, ByVal eventArgs As System.EventArgs) Handles Timer1.Tick
If mosse = 0 Then
lblInfo.Text = DateTime.Now.ToString
Partenza = DateTime.Now
Else
Tempo = DateTime.FromOADate(DateTime.Now.ToOADate - Partenza.ToOADate)
lblInfo.Text = "Tempo: " & Tempo
End If
End Sub
Private Sub Button_Auto_Click(sender As Object, e As EventArgs) Handles Button_Auto.Click
AutoOn = True
For a As Integer = 1 To 3000
If AutoOn = False Then Exit For
Application.DoEvents()
But_Down_Click(But_Down, New System.EventArgs())
If AutoOn = False Then Exit For
Application.DoEvents()
But_L_Click(But_L, New System.EventArgs())
If AutoOn = False Then Exit For
Application.DoEvents()
But_Down_Click(But_Down, New System.EventArgs())
If AutoOn = False Then Exit For
Application.DoEvents()
But_L_Click(But_L, New System.EventArgs())
If AutoOn = False Then Exit For
If a Mod 10 = 0 Then
But_R_Click(But_R, New System.EventArgs())
End If
If AutoOn = False Then Exit For
If Mosse_Auto = False And a Mod 500 = 0 Then
Mosse_Auto = True
But_UP_Click(But_UP, New System.EventArgs())
Application.DoEvents()
End If
Next
End Sub
Private Sub Butt_Stop_Click(sender As Object, e As EventArgs) Handles Butt_Stop.Click
AutoOn = False
Application.DoEvents()
End Sub
Private Sub AboutToolStripMenuItem_Click(sender As Object, e As EventArgs) Handles AboutToolStripMenuItem.Click
AboutBox1.Show()
Me.Enabled = False
End Sub
Private Sub Form1_FormClosing(sender As Object, e As FormClosingEventArgs) Handles MyBase.FormClosing
My.Settings.Save()
End Sub
Private Sub Crea_Simboli(TipoSimboli As Short)
Dim imgbmp As Bitmap = Nothing
ImageList1.Images.Clear()
If TipoSimboli = 1 Then
Dim Fondo As New SolidBrush(Color.FromArgb(255, 14, 209, 69)) ' fondo 2
For i = 0 To 12
imgbmp = New Bitmap(84, 84) ' creo una bitmap
Using g As Graphics = Graphics.FromImage(imgbmp) ' g agisce su imgbmp
g.TextRenderingHint = Drawing.Text.TextRenderingHint.AntiAliasGridFit
Dim Testo As String = 2 ^ (i + 1).ToString ' testo da scrivere
If i = 1 Then Fondo = New SolidBrush(Color.FromArgb(255, 255, 127, 39)) ' fondo 4
If i = 2 Then Fondo = New SolidBrush(Color.FromArgb(255, 185, 122, 86)) ' fondo 8
If i = 3 Then Fondo = New SolidBrush(Color.FromArgb(255, 0, 168, 243)) ' fondo 16
If i = 4 Then Fondo = New SolidBrush(Color.FromArgb(255, 225, 184, 44)) ' fondo 32
If i = 5 Then Fondo = New SolidBrush(Color.FromArgb(255, 0, 53, 243)) ' fondo 64
If i = 6 Then Fondo = New SolidBrush(Color.FromArgb(255, 255, 242, 0)) ' fondo 128
If i = 7 Then Fondo = New SolidBrush(Color.FromArgb(255, 196, 255, 14)) ' fondo 256
If i = 8 Then Fondo = New SolidBrush(Color.FromArgb(255, 160, 13, 234)) ' fondo 512
If i = 9 Then Fondo = New SolidBrush(Color.FromArgb(255, 155, 112, 77)) ' fondo 1024
If i = 10 Then Fondo = New SolidBrush(Color.FromArgb(255, 230, 17, 81)) ' fondo 2048
If i = 11 Then Fondo = New SolidBrush(Color.FromArgb(255, 181, 181, 223)) ' fondo 4096
If i = 12 Then Fondo = New SolidBrush(Color.FromArgb(255, 91, 92, 67)) ' fondo 8192
g.FillRectangle(Brushes.Snow, 0, 0, 84, 84)
g.FillEllipse(Fondo, -14, -14, 111, 111)
If i < 2 Then
Using Carattere As Font = New Font("Arial", 26, FontStyle.Bold)
g.DrawString(Testo, Carattere, Brushes.Black, New PointF(26, 22)) ' 2 e 4
End Using
ElseIf i = 2 Then
Using Carattere As Font = New Font("Arial", 26, FontStyle.Regular)
g.DrawString(Testo, Carattere, Brushes.White, New PointF(26, 22)) ' 8
End Using
ElseIf i = 3 Then
Using Carattere As Font = New Font("Arial", 26, FontStyle.Regular)
g.DrawString(Testo, Carattere, Brushes.DarkRed, New PointF(18, 22)) ' 16
End Using
ElseIf i = 4 Then
Using Carattere As Font = New Font("Arial", 26, FontStyle.Regular)
g.DrawString(Testo, Carattere, Brushes.Blue, New PointF(18, 22)) ' 32
End Using
ElseIf i = 5 Then
Using Carattere As Font = New Font("Arial", 26, FontStyle.Regular)
g.DrawString(Testo, Carattere, Brushes.Yellow, New PointF(18, 22)) ' 64
End Using
ElseIf i = 6 Then
Using Carattere As Font = New Font("Arial", 26, FontStyle.Regular)
g.DrawString(Testo, Carattere, Brushes.Blue, New PointF(5, 22)) ' 128
End Using
ElseIf i = 7 Then
Using Carattere As Font = New Font("Arial", 26, FontStyle.Regular)
g.DrawString(Testo, Carattere, Brushes.Black, New PointF(8, 22)) ' 256
End Using
ElseIf i = 8 Then
Using Carattere As Font = New Font("Arial", 26, FontStyle.Regular)
g.DrawString(Testo, Carattere, Brushes.White, New PointF(8, 22)) ' 512
End Using
ElseIf i = 9 Then
Using Carattere As Font = New Font("Arial", 22, FontStyle.Regular)
g.DrawString(Testo, Carattere, Brushes.LimeGreen, New PointF(5, 26)) ' 1024
End Using
ElseIf i = 10 Then
Using Carattere As Font = New Font("Arial", 22, FontStyle.Regular)
g.DrawString(Testo, Carattere, Brushes.White, New PointF(5, 26)) ' 2048
End Using
ElseIf i = 11 Then
Using Carattere As Font = New Font("Arial", 22, FontStyle.Regular)
g.DrawString(Testo, Carattere, Brushes.DarkRed, New PointF(5, 26)) ' 4096
End Using
ElseIf i = 12 Then
Using Carattere As Font = New Font("Arial", 22, FontStyle.Regular)
g.DrawString(Testo, Carattere, Brushes.Red, New PointF(5, 26)) ' 8192
End Using
End If
End Using
ImageList1.Images.Add(imgbmp)
Next
Panel1.BackColor = Color.Snow
PictureBox1.BackColor = Color.Silver
Call ToolStrip_Checked(TipoGrafica)
ElseIf TipoSimboli = 2 Then
Dim Fondo As New SolidBrush(Color.FromArgb(255, 245, 245, 245))
For i = 0 To 12
imgbmp = New Bitmap(84, 84) ' creo una bitmap
Using g As Graphics = Graphics.FromImage(imgbmp) ' g agisce su imgbmp
g.TextRenderingHint = Drawing.Text.TextRenderingHint.AntiAliasGridFit
Dim Testo As String = 2 ^ (i + 1).ToString ' testo da scrivere
If i = 1 Then Fondo = New SolidBrush(Color.FromArgb(255, 245, 245, 220))
If i = 2 Then Fondo = New SolidBrush(Color.FromArgb(255, 242, 177, 121))
If i = 3 Then Fondo = New SolidBrush(Color.FromArgb(255, 245, 149, 99))
If i = 4 Then Fondo = New SolidBrush(Color.FromArgb(255, 245, 124, 97))
If i = 5 Then Fondo = New SolidBrush(Color.FromArgb(255, 255, 10, 10))
If i = 6 Then Fondo = New SolidBrush(Color.FromArgb(255, 250, 220, 90))
If i = 7 Then Fondo = New SolidBrush(Color.FromArgb(255, 240, 225, 80))
If i = 8 Then Fondo = New SolidBrush(Color.FromArgb(255, 235, 200, 0))
If i = 9 Then Fondo = New SolidBrush(Color.FromArgb(255, 230, 190, 0))
If i = 10 Then Fondo = New SolidBrush(Color.FromArgb(255, 220, 160, 0))
If i = 11 Then Fondo = New SolidBrush(Color.FromArgb(255, 0, 64, 0))
If i = 12 Then Fondo = New SolidBrush(Color.FromArgb(255, 0, 0, 192))
g.FillRectangle(Fondo, 4, 4, 76, 76)
If i < 3 Then
Using Carattere As Font = New Font("Arial", 32, FontStyle.Bold)
g.DrawString(Testo, Carattere, Brushes.DarkSlateGray, New PointF(24, 20))
End Using
ElseIf i < 6 And i > 2 Then
Using Carattere As Font = New Font("Arial", 32, FontStyle.Bold)
g.DrawString(Testo, Carattere, Brushes.White, New PointF(12, 20))
End Using
ElseIf i < 9 And i > 5 Then
Using Carattere As Font = New Font("Arial", 28, FontStyle.Bold)
g.DrawString(Testo, Carattere, Brushes.White, New PointF(6, 22))
End Using
ElseIf i < 13 And i > 8 Then
Using Carattere As Font = New Font("Arial", 22, FontStyle.Bold)
g.DrawString(Testo, Carattere, Brushes.White, New PointF(5, 26))
End Using
End If
End Using
ImageList1.Images.Add(imgbmp)
Next
Panel1.BackColor = Color.Gray
PictureBox1.BackColor = Color.Gray
Call ToolStrip_Checked(TipoGrafica)
ElseIf TipoSimboli = 3 Then
Dim Fondo As New SolidBrush(Color.FromArgb(255, 220, 220, 220))
Dim Penna As New SolidBrush(Color.FromArgb(255, 40, 40, 40))
Dim Testo As String
For i = 0 To 12
imgbmp = New Bitmap(84, 84) ' creo una bitmap
Using g As Graphics = Graphics.FromImage(imgbmp) ' g agisce su imgbmp
g.TextRenderingHint = Drawing.Text.TextRenderingHint.AntiAliasGridFit
g.SmoothingMode = SmoothingMode.AntiAlias ' qualità disegno
Testo = 2 ^ (i + 1).ToString ' testo da scrivere
Penna = New SolidBrush(Color.FromArgb(255, 10 * i, i * 10, 21 * i))
g.FillRectangle(Fondo, 0, 0, 84, 84)
Call Poligono_Regolare(g, Penna, 28 - i, i + 3, 42, 41, 0)
If i < 13 And i > 8 Then
Using Carattere As Font = New Font("Arial", 22, FontStyle.Bold)
g.DrawString(2 ^ (i + 1).ToString, Carattere, Brushes.White, New PointF(5, 26))
End Using
End If
End Using
ImageList1.Images.Add(imgbmp)
Next
Panel1.BackColor = Color.IndianRed
PictureBox1.BackColor = Color.DarkKhaki
Call ToolStrip_Checked(TipoGrafica)
ElseIf TipoSimboli = 4 Then
Dim Fondo As New SolidBrush(Color.Blue)
Dim Penna As New SolidBrush(Color.Yellow)
For i = 0 To 12
imgbmp = New Bitmap(84, 84) ' creo una bitmap
Using g As Graphics = Graphics.FromImage(imgbmp) ' g agisce su imgbmp
g.FillRectangle(Fondo, 0, 0, 84, 84)
g.FillRectangle(Penna, 0, 80 - i * 6, 84, 84)
End Using
ImageList1.Images.Add(imgbmp)
Next
Panel1.BackColor = Color.Coral
PictureBox1.BackColor = Color.Brown
Call ToolStrip_Checked(TipoGrafica)
ElseIf TipoSimboli = 5 Then
For i = 0 To 12
ImageList1.Images.Add(ImageList2.Images(i))
Next
Panel1.BackColor = Color.Brown
PictureBox1.BackColor = Color.Brown
Call ToolStrip_Checked(TipoGrafica)
ElseIf TipoSimboli = 6 Then
For i = 0 To 12
ImageList1.Images.Add(ImageList3.Images(i))
Next
Panel1.BackColor = Color.DarkGreen
PictureBox1.BackColor = Color.DarkGreen
Call ToolStrip_Checked(TipoGrafica)
ElseIf TipoSimboli = 7 Then
Dim Roma() As String = {" I", " II", " III", " IV", " V", " VI", " VII", " VIII", " IX", " X", " XI", " XII", " XIII"}
For i = 0 To 12
imgbmp = New Bitmap(84, 84) ' creo una bitmap
Using g As Graphics = Graphics.FromImage(imgbmp) ' g agisce su imgbmp
g.TextRenderingHint = Drawing.Text.TextRenderingHint.AntiAliasGridFit
g.FillRectangle(Brushes.Navy, 0, 0, 84, 84)
Using Carattere As Font = New Font("Georgia", 22, FontStyle.Regular)
g.DrawString(Roma(i), Carattere, Brushes.Red, New PointF(5, 26))
End Using
End Using
ImageList1.Images.Add(imgbmp)
Next
Panel1.BackColor = Color.Tomato
PictureBox1.BackColor = Color.Navy
Call ToolStrip_Checked(TipoGrafica)
ElseIf TipoSimboli = 8 Then
Dim Lettere() As String = {" A", " B", " C", " D", " E", " F", " G", " H", " I", " J", " K", " L", " M"}
For i = 0 To 12
imgbmp = New Bitmap(84, 84) ' creo una bitmap
Using g As Graphics = Graphics.FromImage(imgbmp) ' g agisce su imgbmp
g.TextRenderingHint = Drawing.Text.TextRenderingHint.AntiAliasGridFit
g.FillRectangle(Brushes.Navy, 0, 0, 84, 84)
Using Carattere As Font = New Font("Georgia", 32, FontStyle.Regular)
g.DrawString(Lettere(i), Carattere, Brushes.Red, New PointF(-10, 16))
End Using
End Using
ImageList1.Images.Add(imgbmp)
Next
Panel1.BackColor = Color.Tomato
PictureBox1.BackColor = Color.Navy
Call ToolStrip_Checked(TipoGrafica)
End If
End Sub
Public Sub ToolStrip_Checked(ByRef TS As Short)
Me.ImmaginiSet1ToolStrip.Checked = False
Me.ImmaginiSet2ToolStrip.Checked = False
Me.ImmaginiSet3ToolStrip.Checked = False
Me.ImmaginiSet4ToolStrip.Checked = False
Me.ImmaginiSet5ToolStrip.Checked = False
Me.ImmaginiSet6ToolStrip.Checked = False
Me.ImmaginiSet7ToolStrip.Checked = False
Me.ImmaginiSet8ToolStrip.Checked = False
Select Case TS
Case = 1
Me.ImmaginiSet1ToolStrip.Checked = True
Case = 2
Me.ImmaginiSet2ToolStrip.Checked = True
Case = 3
Me.ImmaginiSet3ToolStrip.Checked = True
Case = 4
Me.ImmaginiSet4ToolStrip.Checked = True
Case = 5
Me.ImmaginiSet5ToolStrip.Checked = True
Case = 6
Me.ImmaginiSet6ToolStrip.Checked = True
Case = 7
Me.ImmaginiSet7ToolStrip.Checked = True
Case = 8
Me.ImmaginiSet8ToolStrip.Checked = True
End Select
End Sub
Private Sub VisualizzaTest()
For i As Int32 = 0 To 12
Mat4x4Pict_2040(i + 1).Image = ImageList1.Images(i)
Next i
End Sub
Private Sub printmatrice(ByRef Matr2048 As Int32(,))
' mostra lo stato della matrice solo per debug
For R = 1 To 4
Debug.
Print(Matr2048
(R, 1
).
ToString & Matr2048
(R, 2
).
ToString & Matr2048
(R, 3
).
ToString & Matr2048
(R, 4
).
ToString) Next
End Sub
Private Sub ImmaginiSet1ToolStrip_Click(sender As Object, e As EventArgs) Handles ImmaginiSet1ToolStrip.Click
TipoGrafica = 1
My.Settings.Immagini_Set = TipoGrafica
My.Settings.Save()
Call Crea_Simboli(TipoGrafica)
For j = 1 To 16
Mat4x4Pict_2040(j).BackColor = Color.Bisque
Next
Call Visualizza_Immagine_Celle2048(Matrice4x4)
InMovimento = False
End Sub
Private Sub ImmaginiSet2ToolStrip_Click(sender As Object, e As EventArgs) Handles ImmaginiSet2ToolStrip.Click
TipoGrafica = 2
My.Settings.Immagini_Set = TipoGrafica
My.Settings.Save()
Call Crea_Simboli(TipoGrafica)
For j = 1 To 16
Mat4x4Pict_2040(j).BackColor = Color.DarkGray
Next
Call Visualizza_Immagine_Celle2048(Matrice4x4)
InMovimento = False
End Sub
Private Sub ImmaginiSet3ToolStrip_Click(sender As Object, e As EventArgs) Handles ImmaginiSet3ToolStrip.Click
TipoGrafica = 3
My.Settings.Immagini_Set = TipoGrafica
My.Settings.Save()
Call Crea_Simboli(TipoGrafica)
For j = 1 To 16
Mat4x4Pict_2040(j).BackColor = Color.DarkKhaki
Next
Call Visualizza_Immagine_Celle2048(Matrice4x4)
InMovimento = False
End Sub
Private Sub ImmaginiSet4ToolStrip_Click(sender As Object, e As EventArgs) Handles ImmaginiSet4ToolStrip.Click
TipoGrafica = 4
My.Settings.Immagini_Set = TipoGrafica
My.Settings.Save()
Call Crea_Simboli(TipoGrafica)
For j = 1 To 16
Mat4x4Pict_2040(j).BackColor = Color.DarkKhaki
Next
Call Visualizza_Immagine_Celle2048(Matrice4x4)
InMovimento = False
End Sub
Private Sub ImmaginiSet5ToolStrip_Click(sender As Object, e As EventArgs) Handles ImmaginiSet5ToolStrip.Click
TipoGrafica = 5
My.Settings.Immagini_Set = TipoGrafica
My.Settings.Save()
Call Crea_Simboli(TipoGrafica)
For j = 1 To 16
Mat4x4Pict_2040(j).BackColor = Color.Brown
Next
Call Visualizza_Immagine_Celle2048(Matrice4x4)
InMovimento = False
End Sub
Private Sub ImmaginiSet6ToolStrip_Click(sender As Object, e As EventArgs) Handles ImmaginiSet6ToolStrip.Click
TipoGrafica = 6
My.Settings.Immagini_Set = TipoGrafica
My.Settings.Save()
Call Crea_Simboli(TipoGrafica)
For j = 1 To 16
Mat4x4Pict_2040(j).BackColor = Color.DarkGreen
Next
Call Visualizza_Immagine_Celle2048(Matrice4x4)
InMovimento = False
End Sub
Private Sub ImmaginiSet7ToolStrip_Click(sender As Object, e As EventArgs) Handles ImmaginiSet7ToolStrip.Click
TipoGrafica = 7
My.Settings.Immagini_Set = TipoGrafica
My.Settings.Save()
Call Crea_Simboli(TipoGrafica)
For j = 1 To 16
Mat4x4Pict_2040(j).BackColor = Color.Navy
Next
Call Visualizza_Immagine_Celle2048(Matrice4x4)
InMovimento = False
End Sub
Private Sub ImmaginiSet8ToolStrip_Click(sender As Object, e As EventArgs) Handles ImmaginiSet8ToolStrip.Click
TipoGrafica = 8
My.Settings.Immagini_Set = TipoGrafica
My.Settings.Save()
Call Crea_Simboli(TipoGrafica)
For j = 1 To 16
Mat4x4Pict_2040(j).BackColor = Color.Navy
Next
Call Visualizza_Immagine_Celle2048(Matrice4x4)
InMovimento = False
End Sub
Private Sub Animazione1ToolStrip_Click(sender As Object, e As EventArgs) Handles Animazione1ToolStrip.Click
Me.Animazione1ToolStrip.Checked = True
Me.Animazione2ToolStrip.Checked = False
Me.Animazione3ToolStrip.Checked = False
My.Settings.Animazione_1 = True
My.Settings.Animazione_2 = False
My.Settings.Animazione_3 = False
End Sub
Private Sub Animazione2ToolStrip_Click(sender As Object, e As EventArgs) Handles Animazione2ToolStrip.Click
Me.Animazione2ToolStrip.Checked = True
Me.Animazione1ToolStrip.Checked = False
Me.Animazione3ToolStrip.Checked = False
My.Settings.Animazione_2 = True
My.Settings.Animazione_1 = False
My.Settings.Animazione_3 = False
End Sub
Private Sub Animazione3ToolStrip_Click(sender As Object, e As EventArgs) Handles Animazione3ToolStrip.Click
Me.Animazione3ToolStrip.Checked = True
Me.Animazione1ToolStrip.Checked = False
Me.Animazione2ToolStrip.Checked = False
My.Settings.Animazione_3 = True
My.Settings.Animazione_1 = False
My.Settings.Animazione_2 = False
End Sub
Private Sub Poligono_Regolare(ByVal GR As Graphics, ByVal Solido As Brush, ByVal MisurLato As Single, ByVal NumLati As Single, ByVal XCentro As Single, ByVal YCentro As Single, ByVal GradiRotaz As Single)
'Trasforma i GradiRotaz in Radianti
Dim RadiantiRotaz As Single = GradiRotaz * Math.PI / 180
'Archi del cerchio(IN RADIANTI)entro il quale s'immagina inscritto il poligono,
'occupati dal punto ZERO (minima coordinata Y dell'area di disegno)all'estremo
'finale di ogni lato. Non serve l'estremo dell'ultimo lato, perchè è uguale al
'punto ZERO.
Dim ARCHI As Single = 360 * Math.PI / 180 / NumLati
'Dichiara una Matrice con numero elementi pari a NumLati per contenere
'l'arco complessivo(in RADIANTI)occupato dal punto più alto del cerchio
'(zero radianti)ai punti successivi (estremi dei lati).
Dim Arc(NumLati) As Single
'Carica la matrice con gli archi complessivi (in radianti) dei suddetti punti
For k As Short = 0 To NumLati
Arc(k) = ARCHI * k
Next
' 1)Calcolo del Numero Fisso (serve solo il numero dei lati: NumLati)
Dim NFisso As Single = 0.5 / Math.Tan(Math.PI / NumLati)
' 2)Calcolo Apotema (servono Numero Fisso e Misura del Lato)
Dim Apotema As Single = NFisso * MisurLato
' 3)Calcolo Raggio del cerchio in cui il poligono si immagina iscritto (è
' anche il raggio del poligono)
Dim Raggio As Single = Math.Sqrt(Apotema ^ 2 + (MisurLato / 2) ^ 2)
'Dichiara una Matrice con numero elementi pari a NumLati per contenere le
'coordinate X di ogni punto
Dim XPunto(NumLati) As Single
'Dichiara una Matrice con numero elementi pari a NumLati per contenere le
'coordinate Y di ogni punto
Dim YPunto(NumLati) As Single
'Carica le 2 matrici suddette con le relative coordinate X ed Y
For k As Short = 0 To NumLati - 1
XPunto(k) = XCentro + Raggio * Math.Sin(Arc(k) + RadiantiRotaz)
YPunto(k) = YCentro - Raggio * Math.Cos(Arc(k) + RadiantiRotaz)
Next
'Definisce un'istanza della Classe GraphicsPath, atta a contenere un
' "insieme" di disegni
Dim pa As New GraphicsPath
' Crea un Path(=Percorso) con tutte le linee CONSECUTIVE che costituiscono
' i Lati di un poligono tranne l'ultima, che è aggiunta poi tramite
' "CloseFigure()"
For k As Short = 0 To NumLati - 2
pa.AddLine(XPunto(k), YPunto(k), XPunto(k + 1), YPunto(k + 1))
Next (k)
'La seg. istruzione chiude il poligono, creando automaticamente l'ultimo lato
pa.CloseFigure()
'DISEGNA IL POLIGONO REGOLARE (che corrisponde al path appena costruito)
GR.FillPath(Solido, pa)
End Sub
Private Sub VediSetimmaginiToolStrip_Click(sender As Object, e As EventArgs) Handles VediSetimmaginiToolStrip.Click
Call VisualizzaTest()
End Sub
Private Sub AnimazioneOnoffToolStrip_Click(sender As Object, e As EventArgs) Handles AnimazioneOnoffToolStrip.Click
If Animazione_On Then
Animazione_On = False
Else
Animazione_On = True
End If
End Sub
Private Sub AudioOnOffToolStrip_Click(sender As Object, e As EventArgs) Handles AudioOnOffToolStrip.Click
If Audio_On Then
Audio_On = False
Else
Audio_On = True
End If
End Sub
End Class
Modificato :k: