Piramide Numerica, L'allena mente! Opzioni

[-DjGG-]

La piramide numerica

BETA (Open Source)

Qualcuno di voi già mi conoscerà come il creatore di GBARL Fox e anche come creatore di altri progetti Open Source (mi trovate su Planet Source Code, basta cercare djgg nella sezione Visual Basic), quali il gioco LIGHTS e il NINTENDO DS R4 Theme Editor.
Ultimamente, sul treno, sotto gli occhi curiosi di alcuni viaggiatori, ho fatto nascere LA PIRAMIDE NUMERICA che è il mio ennesimo progetto Open Source. Ancora non lo trovate disponibile in forma sorgente su PSC, ma siccome sono un utente affezionato a GBArl e anche agli amici che ho trovato sempre qui, vi voglio fare provare in anteprima questo allena mente.

Lo scopo del gioco è semplicissimo: Indovinare tutti i numeri da inserire nelle palline della piramide.
Come? Semplicemente usando una regola: il numero che sta al centro delle due palline sottostanti, corrisponde al risultato della somma di esse... contorta la cosa? No, dai! Basta osservare lo screenshoot per capire!
Gli schemi sono da completare entro un determinato tempo, scaduto tale tempo il gioco sarà terminato.
Gli schemi non saranno MAI uguali poichè a generarli è il computer!

Non sono stato a curare la grafica, poichè trattandosi di progetto Open Source, io do l'idea e poi altri modificano a loro piacimento. Inutile dirvi che magari i colori non saranno graditi e bla bla bla, è una versione BETA e come ripeto Open Source, quindi, appena posterò i sorgenti, potrete smanettare e modificare come vorrete.

Il gioco attualmente pesa.... tenetevi forte... 55,55 Kb ce la faranno i vostri hard disk?

Potete scaricare l'anteprima assoluta da qui: DOWNLOAD RIMOSSO

Segnalazioni per eventuali bug sono graditissime!

» Clicca per leggere lo Spoiler! «

Se vorrete utilizzare questo thread per aprire una sorta di sfida postando i vostri risultati [admin permettendo ] (punteggio e livello raggiunto) ben venga... ma se truciate, me ne accorgo!

Buon allenamento!

Programmato in VB6 su un ASUS Eee 1000HG

[MaryDS]

è solo per PC o c'è anche una versione per DS o MAC?

[-DjGG-]

No, è solo per PC, ma se qualche altro sviluppatore vuole convertirlo per altre piattaforme... faccia pure, a giorni metterò i sorgenti online

[MasterDs]

Complimenti DjGG!
Semplice ma anche abbastanza divertente!

[MaryDS]

No, è solo per PC, ma se qualche altro sviluppatore vuole convertirlo per altre piattaforme... faccia pure, a giorni metterò i sorgenti online

Mi spiace non sono una programmatrice altrimenti ti aiuterei volentieri!

[lucaluca]

Ottimo gioco, forse la grafica da rivisitare, ma è un fatto personale.

EDIT: al rilascio dei sorgenti proverò a portarlo in vb.net (per rendere accessibile il codice anche a chi si destreggia meglio col .net)
e probabilmente in Gambas (per Linux)

[narutoflame]

grazie mille,mi è piaciuta tanto la versione cartacea,ora provo questo,thanks

[60661_F4810]

Io l'ho provato ed ho fatto un pò di partite.
Ci sono 2 bei problemi:
Capita che non venga dato almeno uno dei cinque numeri lungo uno dei lati del triangolo creando cosi un'infinità di soluzioni possibili
Il punteggio max non viene aggiornato, anzi se fai più partite consecutivamente si somma a quello precedente.

La mia non vuol essere una critica... ho pensato che magari potesse servirti
Complimenti per il tuo lavoro!! Ciao

[-DjGG-]

grazie mille,mi è piaciuta tanto la versione cartacea,ora provo questo,thanks

Accidenti non ci credo! Conosci la versione cartacea (antica) a cui mi sono ispirato!
Effettivamente questo gioco è nato proprio osservando i tanti viaggiatori che giocavano con la settimana enigmistica...

Io l'ho provato ed ho fatto un pò di partite.
Ci sono 2 bei problemi:
Capita che non venga dato almeno uno dei cinque numeri lungo uno dei lati del triangolo creando cosi un'infinità di soluzioni possibili
Il punteggio max non viene aggiornato, anzi se fai più partite consecutivamente si somma a quello precedente.

La mia non vuol essere una critica... ho pensato che magari potesse servirti
Complimenti per il tuo lavoro!! Ciao

Nono, nessuna critica, ANZI GRAZIE! Pensa che figuraccia se postavo il codice sorgente con il bug del punteggio! Comunque per le infinite soluzioni, non ti preoccupare (è fatto apposta), l'importante è fare quadrare lo schema, infatti il gioco è programmato per calcolare e verificare che lo schema che hai scritto sia esatto.

Ribadisco, qualunque segnalazione è ben gradita!

[-DjGG-]

NUOVA VERSIONE DISPONIBILE

Rilasciata il 14/07/2009

A distanza di 4 giorni, ho corretto i bug che mi avete segnalato, fiducioso in un vostro ulteriore riscontro vi invito a scaricare la versione 1.0.9 BETA dal seguente link:

DOWNLOAD RIMOSSO

Naturalmente se trovate ancora qualche pecca... segnalate pure!

[LuigiEdgeworth]

e' carino complimenti

[yagamix]

il gioco è carino! bravo

[BobArctor]

grande!!! complimenti!!!
allora non sono l'unico che programma sul treno :-P
a forza di fare maccarese/forte dei marmi ho scoperto che vado meglio sul treno che a casa/uni XD

[-DjGG-]

grande!!! complimenti!!!
allora non sono l'unico che programma sul treno :-P
a forza di fare maccarese/forte dei marmi ho scoperto che vado meglio sul treno che a casa/uni XD

Meno male che non sono l'unico! Io però viaggio sulla tratta Milano Torino

[Nicovas]

well done my friend

[The Lemon Man]

omg dj io lo volevo in python! Promettimi che la prossima cosa che farai è la scopa con python!!! promettimelo! Col c è stato un casino ma cè l ho fatta, tra (poco ?) arriverà scopawii su tutte le vostre wii

[-DjGG-]

SORGENTI RILASCIATI

Con immenso piacere vi comunico che da QUI è possibile effettuare il download della versione definitiva della Piramide Numerica.
Purtroppo per cause tecniche (manutenzione al sito) da Planet Source Code non è ancora possibile effettuare il download dell'archivio compresso con dentro i sorgenti in Visual Basic 6.0 MA dal momento che su GBArl: "E' consentito ed incoraggiato, invece, il pubblicare e discutere di materiale open-source, ovvero di cui il detentore dei diritti ha rilasciato il codice sorgente ed autorizzato la copia e libera circolazione/modifica/riutilizzo, sempre nel rispetto della licenza da egli scelta per la sua opera; altrettanto benvenuti Come da manifesto, questa Community fa dell'hacking parte della sua stessa essenza e, per questo, intende appoggiarlo pienamente.", vi metto in anteprima i sorgenti QUIi:

La realizzazione di questo gioco ha impiegato:
2 FORM
1 MODULO

Il FORM principale, quello del gioco, si chiama frmGame. Il FORM secondario, quello delle informazioni sul gioco, si chiama frmAbout, mentre il MODULO si chiama semplicemente Module1

Se invece volete dare una occhiata al codice sorgente senza scaricare i file, potete dare un'occhiata agli spoiler.

frmGame
[spoiler]

CODICE

'------------------------------------------------------------------------------------------------------------

'Nome progetto: Piramide numerica

'Autore: -DjGG-

'BETA Tester: Patty

'Data di creazione: 29/06/2009

'Data di ultimazione: 03/08/2009

'Descrizione di questo programa: Gioco matematico, il cui scopo è quello di indovinare il valore numerico

'                                delle caselle vuote e completare la piramide.

'Regole del gioco: Il numero da inserire nelle palline centrali è dato dalla somma delle due sottostanti

'Esempio:

'

'                       (___)

'

'                    (___)  (___)

'

'                 (___) (___) (___)

'

'               ( 3 ) ( 6 ) ( 9 ) ( 11 )

'

'            ( 1 ) ( 2 ) ( 4 ) ( 5 ) ( 6 )

'

'Note aggiuntive: Dedicato alla mia promessa sposa Samantha.

'-----------------------------------------------------------------------------------------------------------

'

'SCHEMA DELLE CASELLE DI TESTO

'

'              ( T1 ) LINEA5

'

'          ( T2 )  ( T3 ) LINEA4

'

'       ( T4 ) ( T5 ) ( T6 ) LINEA3

'

'   ( T7 ) ( T8 ) ( T9 ) ( T10 ) LINEA2

'

'( T11 )( T12 )( T13 )( T14 )( T15 ) LINEA1

'

'Dichiaro tutte le variabili

Dim Livello, TempoR, OldTempoR, Punti, R1, R2, R3, R4, R5, R6, R7, R8, R9, R10, R11, R12, R13, R14, R15 As Integer

Dim C1, C2, C3, C4, C5, C6, C7, C8, C9, C10, Abilita As Boolean

Dim numROSSI, ShapeC As Integer

Dim mpunt As String

Dim mnome As String

Public Sub NewGame()

Dim x, y As Integer

'Prepara il gioco

    Abilita = False

    RESET

    ATW

    RRESET

    LivelloLBL.Caption = Livello

    numROSSI = 0

    LoadScore

'Genera dei numeri casuali sulle prime 5 caselle della LINEA1

    y = Int(Rnd * 10)

    T11.Text = y

    R11 = T11.Text

    y = Int(Rnd * 10)

    T12.Text = y

    R12 = T12.Text

    y = Int(Rnd * 10)

    T13.Text = y

    R13 = T13.Text

    y = Int(Rnd * 10)

    T14.Text = y

    R14 = T14.Text

    y = Int(Rnd * 10)

    T15.Text = y

    R15 = T15.Text

'Calcola i risultati per la LINEA2

    T7.Text = Val(T11.Text) + Val(T12.Text)

    R7 = T7.Text

    T8.Text = Val(T12.Text) + Val(T13.Text)

    R8 = T8.Text

    T9.Text = Val(T13.Text) + Val(T14.Text)

    R9 = T9.Text

    T10.Text = Val(T14.Text) + Val(T15.Text)

    R10 = T10.Text

'Calcola i risultati per la LINEA3

    T4.Text = Val(T7.Text) + Val(T8.Text)

    R4 = T4.Text

    T5.Text = Val(T8.Text) + Val(T9.Text)

    R5 = T5.Text

    T6.Text = Val(T9.Text) + Val(T10.Text)

    R6 = T6.Text

'Calcola i risultati per la LINEA4

    T2.Text = Val(T4.Text) + Val(T5.Text)

    R2 = T2.Text

    T3.Text = Val(T5.Text) + Val(T6.Text)

    R3 = T3.Text

'Calcola i risultati per la LINEA5

    T1.Text = Val(T2.Text) + Val(T3.Text)

    R1 = T1.Text

'Resetta e imposta il colore blu a tutte le caselle

    RESET

    T1.ForeColor = RGB(0, 0, 255)

    T2.ForeColor = RGB(0, 0, 255)

    T3.ForeColor = RGB(0, 0, 255)

    T4.ForeColor = RGB(0, 0, 255)

    T5.ForeColor = RGB(0, 0, 255)

    T6.ForeColor = RGB(0, 0, 255)

    T7.ForeColor = RGB(0, 0, 255)

    T8.ForeColor = RGB(0, 0, 255)

    T9.ForeColor = RGB(0, 0, 255)

    T10.ForeColor = RGB(0, 0, 255)

    T11.ForeColor = RGB(0, 0, 255)

    T12.ForeColor = RGB(0, 0, 255)

    T13.ForeColor = RGB(0, 0, 255)

    T14.ForeColor = RGB(0, 0, 255)

    T15.ForeColor = RGB(0, 0, 255)

'Blocca alcune caselle per i suggerimenti della LINEA5

    For i = 1 To 10

        x = Int(Rnd * 15)

            If x = 1 Then

                T1.ForeColor = RGB(255, 0, 0)

                T1.Locked = True

                T1.Text = R1

            ElseIf x = 2 Then

                T2.ForeColor = RGB(255, 0, 0)

                T2.Locked = True

                T2.Text = R2

            ElseIf x = 3 Then

                T3.ForeColor = RGB(255, 0, 0)

                T3.Locked = True

                T3.Text = R3

            ElseIf x = 4 Then

                T4.ForeColor = RGB(255, 0, 0)

                T4.Locked = True

                T4.Text = R4

            ElseIf x = 5 Then

                T5.ForeColor = RGB(255, 0, 0)

                T5.Locked = True

                T5.Text = R5

            ElseIf x = 6 Then

                T6.ForeColor = RGB(255, 0, 0)

                T6.Locked = True

                T6.Text = R6

            ElseIf x = 7 Then

                T7.ForeColor = RGB(255, 0, 0)

                T7.Locked = True

                T7.Text = R7

            ElseIf x = 8 Then

                T8.ForeColor = RGB(255, 0, 0)

                T8.Locked = True

                T8.Text = R8

            ElseIf x = 9 Then

                T9.ForeColor = RGB(255, 0, 0)

                T9.Locked = True

                T9.Text = R9

            ElseIf x = 10 Then

                T10.ForeColor = RGB(255, 0, 0)

                T10.Locked = True

                T10.Text = R10

            ElseIf x = 11 Then

                T11.ForeColor = RGB(255, 0, 0)

                T11.Locked = True

                T11.Text = R11

            ElseIf x = 12 Then

                T12.ForeColor = RGB(255, 0, 0)

                T12.Locked = True

                T12.Text = R12

            ElseIf x = 13 Then

                T13.ForeColor = RGB(255, 0, 0)

                T13.Locked = True

                T13.Text = R13

            ElseIf x = 14 Then

                T14.ForeColor = RGB(255, 0, 0)

                T14.Locked = True

                T14.Text = R14

            ElseIf x = 15 Then

                T15.ForeColor = RGB(255, 0, 0)

                T15.Locked = True

                T15.Text = R15

            Else

                i = i - 1

            End If

    Next i

'Conta quanti numeri rossi sono presenti nello schema

    If T1.ForeColor = RGB(255, 0, 0) Then numROSSI = numROSSI + 1

    If T2.ForeColor = RGB(255, 0, 0) Then numROSSI = numROSSI + 1

    If T3.ForeColor = RGB(255, 0, 0) Then numROSSI = numROSSI + 1

    If T4.ForeColor = RGB(255, 0, 0) Then numROSSI = numROSSI + 1

    If T5.ForeColor = RGB(255, 0, 0) Then numROSSI = numROSSI + 1

    If T6.ForeColor = RGB(255, 0, 0) Then numROSSI = numROSSI + 1

    If T7.ForeColor = RGB(255, 0, 0) Then numROSSI = numROSSI + 1

    If T8.ForeColor = RGB(255, 0, 0) Then numROSSI = numROSSI + 1

    If T9.ForeColor = RGB(255, 0, 0) Then numROSSI = numROSSI + 1

    If T10.ForeColor = RGB(255, 0, 0) Then numROSSI = numROSSI + 1

    If T11.ForeColor = RGB(255, 0, 0) Then numROSSI = numROSSI + 1

    If T12.ForeColor = RGB(255, 0, 0) Then numROSSI = numROSSI + 1

    If T13.ForeColor = RGB(255, 0, 0) Then numROSSI = numROSSI + 1

    If T14.ForeColor = RGB(255, 0, 0) Then numROSSI = numROSSI + 1

    If T15.ForeColor = RGB(255, 0, 0) Then numROSSI = numROSSI + 1

    If numROSSI <= 6 Then NewGame

'Attiva il conto alla rovescia

    CDOWN.Enabled = True

    Abilita = True

End Sub



Private Sub CDOWN_Timer()

'Timer di gestione del conto alla rovescia

    If TempoR <= 0 Then

        GameOver

    Else

        TempoR = TempoR - 1

    End If

    TR.Caption = TempoR

End Sub



Private Sub Command1_Click()

'Ferma il tempo

    CDOWN.Enabled = False

End Sub



Private Sub Command2_Click()

'Visualizza la lista della soluzione

    If List1.Visible = True Then

        List1.Visible = False

    Else

        List1.Visible = True

        List1.Clear

        List1.AddItem R1

        List1.AddItem R2

        List1.AddItem R3

        List1.AddItem R4

        List1.AddItem R5

        List1.AddItem R6

        List1.AddItem R7

        List1.AddItem R8

        List1.AddItem R9

        List1.AddItem R10

        List1.AddItem R11

        List1.AddItem R12

        List1.AddItem R13

        List1.AddItem R14

        List1.AddItem R15

    End If

End Sub



Private Sub DEMO_Timer()

'Colora le palline

    If ShapeC = 0 Then

        Colora 255, 255, 0

        ShapeC = ShapeC + 1

    ElseIf ShapeC = 1 Then

        Colora 255, 204, 0

        ShapeC = ShapeC + 1

    ElseIf ShapeC = 2 Then

        Colora 255, 153, 0

        ShapeC = ShapeC + 1

    ElseIf ShapeC = 3 Then

        Colora 255, 102, 0

        ShapeC = ShapeC + 1

    ElseIf ShapeC = 4 Then

        Colora 255, 51, 0

        ShapeC = ShapeC + 1

    ElseIf ShapeC = 5 Then

        Colora 255, 0, 0

        ShapeC = ShapeC + 1

    ElseIf ShapeC = 6 Then

        Colora 255, 51, 0

        ShapeC = ShapeC + 1

    ElseIf ShapeC = 7 Then

        Colora 255, 102, 0

        ShapeC = ShapeC + 1

    ElseIf ShapeC = 8 Then

        Colora 255, 153, 0

        ShapeC = ShapeC + 1

    Else

        Colora 255, 204, 0

        ShapeC = 0

    End If

End Sub



Private Sub Form_Load()

'Resetta le variabili

    RRESET

    Punti = 0

    TempoR = 120

    Livello = 1

    Abilita = False

    ShapeC = 0

'Carica i migliori risultati dal registro di Windows

    LoadScore

'Imposta il titolo, la data, l'ora, e centra la finestra

    DT.Caption = Time & Chr(13) & Date

    Me.Caption = "Piramide numerica Versione " & App.Major & "." & App.Minor & " rev. " & App.Revision & " -DjGG-"

    CF Me

'Pulisce tutte le textbox

    PT

    AWhite

'Inizia a mescolare i numeri

    Randomize

End Sub



Public Sub PT()

'Sub per svuotare le caselle di testo

    T1.Text = ""

    T2.Text = ""

    T3.Text = ""

    T4.Text = ""

    T5.Text = ""

    T6.Text = ""

    T7.Text = ""

    T8.Text = ""

    T9.Text = ""

    T10.Text = ""

    T11.Text = ""

    T12.Text = ""

    T13.Text = ""

    T14.Text = ""

    T15.Text = ""

End Sub

Public Sub LockA()

'Blocca tutte le caselle di testo

    T1.Locked = True

    T2.Locked = True

    T3.Locked = True

    T4.Locked = True

    T5.Locked = True

    T6.Locked = True

    T7.Locked = True

    T8.Locked = True

    T9.Locked = True

    T10.Locked = True

    T11.Locked = True

    T12.Locked = True

    T13.Locked = True

    T14.Locked = True

    T15.Locked = True

End Sub



Public Sub UnlockA()

'Sblocca tutte le caselle di testo

    T1.Locked = False

    T2.Locked = False

    T3.Locked = False

    T4.Locked = False

    T5.Locked = False

    T6.Locked = False

    T7.Locked = False

    T8.Locked = False

    T9.Locked = False

    T10.Locked = False

    T11.Locked = False

    T12.Locked = False

    T13.Locked = False

    T14.Locked = False

    T15.Locked = False

End Sub



Public Sub RESET()

'Esegue pulizia e sblocca le caselle

    PT

    UnlockA

End Sub



Public Sub RRESET()

'Resetta le variabili

    R1 = 0

    R2 = 0

    R3 = 0

    R4 = 0

    R5 = 0

    R6 = 0

    R7 = 0

    R8 = 0

    R9 = 0

    R10 = 0

    R11 = 0

    R12 = 0

    R13 = 0

    R14 = 0

    R15 = 0

    C1 = False

    C2 = False

    C3 = False

    C4 = False

    C5 = False

    C6 = False

    C7 = False

    C8 = False

    C9 = False

    C10 = False

End Sub



Private Sub mnuAbout_Click()

'Informazioni sul gioco

    frmAbout.Show 1

End Sub



Private Sub mnuExit_Click()

'Termina il gioco

    End

End Sub



Private Sub mnuNew_Click()

'Imposta un nuovo gioco

    Abilita = False

    DEMO.Enabled = False

    Colora 255, 255, 255

    TempoR = 120

    OldTempoR = TempoR

    Livello = 1

    If T1.Text <> "" Or _

        T2.Text <> "" Or _

        T3.Text <> "" Or _

        T4.Text <> "" Or _

        T5.Text <> "" Or _

        T6.Text <> "" Or _

        T7.Text <> "" Or _

        T8.Text <> "" Or _

        T9.Text <> "" Or _

        T10.Text <> "" Or _

        T11.Text <> "" Or _

        T12.Text <> "" Or _

        T13.Text <> "" Or _

        T14.Text <> "" Or _

        T15.Text <> "" Then

            response = MsgBox("Terminare la partita corrente per iniziarne una nuova?", vbYesNo, "Nuovo gioco...")

                If response = vbYes Then

                    Punti = 0

                    Punteggio.Caption = Punti

                    NewGame

                Else

                    Exit Sub

                End If

    Else

        NewGame

    End If

End Sub



Public Sub AWhite()

'Imposta il colore bianco a tutti gli Shape e le TextBox

    T1.BackColor = &H80000005

    Shape1.FillColor = &H80000005

    T2.BackColor = &H80000005

    Shape2.FillColor = &H80000005

    T3.BackColor = &H80000005

    Shape3.FillColor = &H80000005

    T4.BackColor = &H80000005

    Shape4.FillColor = &H80000005

    T5.BackColor = &H80000005

    Shape5.FillColor = &H80000005

    T6.BackColor = &H80000005

    Shape6.FillColor = &H80000005

    T7.BackColor = &H80000005

    Shape7.FillColor = &H80000005

    T8.BackColor = &H80000005

    Shape8.FillColor = &H80000005

    T9.BackColor = &H80000005

    Shape9.FillColor = &H80000005

    T10.BackColor = &H80000005

    Shape10.FillColor = &H80000005

    T11.BackColor = &H80000005

    Shape11.FillColor = &H80000005

    T12.BackColor = &H80000005

    Shape12.FillColor = &H80000005

    T13.BackColor = &H80000005

    Shape13.FillColor = &H80000005

    T14.BackColor = &H80000005

    Shape14.FillColor = &H80000005

    T15.BackColor = &H80000005

    Shape15.FillColor = &H80000005

End Sub



'Controllo del testo immesso

'----------------------------------------------------------------------

Private Sub T1_Change()

    CN T1

End Sub



Private Sub T10_Change()

    CN T10

End Sub



Private Sub T11_Change()

    CN T11

End Sub



Private Sub T12_Change()

    CN T12

End Sub



Private Sub T13_Change()

    CN T13

End Sub



Private Sub T14_Change()

    CN T14

End Sub



Private Sub T15_Change()

    CN T15

End Sub



Private Sub T2_Change()

    CN T2

End Sub



Private Sub T3_Change()

    CN T3

End Sub



Private Sub T4_Change()

    CN T4

End Sub



Private Sub T5_Change()

    CN T5

End Sub



Private Sub T6_Change()

    CN T6

End Sub



Private Sub T7_Change()

    CN T7

End Sub



Private Sub T8_Change()

    CN T8

End Sub



Private Sub T9_Change()

    CN T9

End Sub

'----------------------------------------------------------------------



Private Sub Timer1_Timer()

'Colora a caso il titolo del gioco

    Titolo.ForeColor = RGB(255, Rnd * 255, 0)

End Sub



Public Sub ATW()

'Imposta il colore FORECOLOR di tutte le textbox su bianco

    T1.ForeColor = &H80000005

    T2.ForeColor = &H80000005

    T3.ForeColor = &H80000005

    T4.ForeColor = &H80000005

    T5.ForeColor = &H80000005

    T6.ForeColor = &H80000005

    T7.ForeColor = &H80000005

    T8.ForeColor = &H80000005

    T9.ForeColor = &H80000005

    T10.ForeColor = &H80000005

    T11.ForeColor = &H80000005

    T12.ForeColor = &H80000005

    T13.ForeColor = &H80000005

    T14.ForeColor = &H80000005

    T15.ForeColor = &H80000005

End Sub



Public Sub CN(txtbox As TextBox)

'Controlla se è stato inserito un numero nella casella di testo

    If Abilita = True Then

        If IsNumeric(txtbox.Text) = True Then

            'nulla

        Else

            txtbox.Text = ""

            txtbox.SelStart = 0

        End If

        CheckWin

    Else

        'Esce dal controllo

    End If

End Sub



Public Sub CheckWin()

'Controlla se il giocatore ha vinto

'Controlla se le caselle di testo sono vuote

    If T1.Text <> "" And _

    T2.Text <> "" And _

    T3.Text <> "" And _

    T4.Text <> "" And _

    T5.Text <> "" And _

    T6.Text <> "" And _

    T7.Text <> "" And _

    T8.Text <> "" And _

    T9.Text <> "" And _

    T10.Text <> "" And _

    T11.Text <> "" And _

    T12.Text <> "" And _

    T13.Text <> "" And _

    T14.Text <> "" And _

    T15.Text <> "" Then

        FASE2 'compara i valori

    Else

        'esce dal ciclo

    End If

End Sub



Public Sub FASE2()

'Controlla se il risultato finale è quello calcolato dal computer

Dim Result As Integer

Debug.Print "Inizio controllo " & Date & " - " & Time 'Debug

    Result = Val(T11.Text) + Val(T12.Text)

    Debug.Print "T7=" & T7.Text 'Debug

    If Result = Val(T7.Text) Then

        C7 = True

    Else

        C7 = False

    End If

    Result = Val(T12.Text) + Val(T13.Text)

    Debug.Print "T8=" & T8.Text 'Debug

    If Result = Val(T8.Text) Then

        C8 = True

    Else

        C8 = False

    End If

    Result = Val(T13.Text) + Val(T14.Text)

    Debug.Print "T9=" & T9.Text 'Debug

    If Result = Val(T9.Text) Then

        C9 = True

    Else

        C9 = False

    End If

    Result = Val(T14.Text) + Val(T15.Text)

    Debug.Print "T10=" & T10.Text 'Debug

    If Result = Val(T10.Text) Then

        C10 = True

    Else

        C10 = False

    End If

    Result = Val(T7.Text) + Val(T8.Text)

    Debug.Print "T4=" & T4.Text 'Debug

    If Result = Val(T4.Text) Then

        C4 = True

    Else

        C4 = False

    End If

    Result = Val(T8.Text) + Val(T9.Text)

    Debug.Print "T5=" & T5.Text 'Debug

    If Result = Val(T5.Text) Then

        C5 = True

    Else

        C5 = False

    End If

    Result = Val(T9.Text) + Val(T10.Text)

    Debug.Print "T6=" & T6.Text 'Debug

    If Result = Val(T6.Text) Then

        C6 = True

    Else

        C6 = False

    End If

    Result = Val(T4.Text) + Val(T5.Text)

    Debug.Print "T2=" & T2.Text 'Debug

    If Result = Val(T2.Text) Then

        C2 = True

    Else

        C2 = False

    End If

    Result = Val(T5.Text) + Val(T6.Text)

    Debug.Print "T3=" & T3.Text 'Debug

    If Result = Val(T3.Text) Then

        C3 = True

    Else

        C3 = False

    End If

    Result = Val(T2.Text) + Val(T3.Text)

    Debug.Print "T1=" & T1.Text 'Debug

    If Result = Val(T1.Text) Then

        C1 = True

    Else

        C1 = False

    End If

'Debug

'-----------------------------------------------------------------------

Debug.Print "C1=" & C1

Debug.Print "C2=" & C2

Debug.Print "C3=" & C3

Debug.Print "C4=" & C4

Debug.Print "C5=" & C5

Debug.Print "C6=" & C6

Debug.Print "C7=" & C7

Debug.Print "C8=" & C8

Debug.Print "C9=" & C9

Debug.Print "C10=" & C10

'----------------------------------------------------------------------

    Result = Val(T2.Text) + Val(T3.Text)

    If Result = R1 And Val(T1.Text) = R1 Then

    Debug.Print "R1=" & R1 'Debug

'Controllo finale

'----------------------------------------------------------------------

        If C2 = True And C3 = True And C4 = True And _

            C5 = True And C6 = True And C7 = True And _

            C8 = True And C9 = True And C10 = True Then

                CDOWN.Enabled = False

                MsgBox ("HAI VINTO, preparati per il nuovo livello!"), vbExclamation, "GRANDIOSO!"

                Punti = Punti + 15

                OldTempoR = OldTempoR - 10

                TempoR = OldTempoR

                Punteggio.Caption = Punti

                Livello = Livello + 1

                NewGame

            Else

                'esce dal ciclo

            End If

    Else

        'esce dal ciclo

    End If

End Sub



Private Sub Timer2_Timer()

'Aggiorna data e ora

    DT.Caption = Time & Chr(13) & Date

End Sub



Public Sub GameOver()

'Gioco finito

    DEMO.Enabled = True

    CDOWN.Enabled = False

    If mpunt > Punti Then

        MsgBox "HAI PERSO!!!" & Chr(13) & "Purtroppo non hai realizzato un nuovo record", vbCritical, "NOOoooo...."

    Else

        mpunt = Punti

        nome = InputBox("Complimenti hai realizzato un nuovo record, inserisci il tuo nome!", "Gioco finito!", mname)

        SaveSetting "PNUM", "SCORE", "HISCORE", mpunt

        SaveSetting "PNUM", "SCORE", "NSCORE", nome

        LoadScore

    End If

    LockA

End Sub



Public Sub Colora(R As Integer, G As Integer, B As Integer)

'Colorazione delle palline e delle textbox

    Shape1.FillColor = RGB(R, G, B)

    Shape2.FillColor = RGB(R, G, B)

    Shape3.FillColor = RGB(R, G, B)

    Shape4.FillColor = RGB(R, G, B)

    Shape5.FillColor = RGB(R, G, B)

    Shape6.FillColor = RGB(R, G, B)

    Shape7.FillColor = RGB(R, G, B)

    Shape8.FillColor = RGB(R, G, B)

    Shape9.FillColor = RGB(R, G, B)

    Shape10.FillColor = RGB(R, G, B)

    Shape11.FillColor = RGB(R, G, B)

    Shape12.FillColor = RGB(R, G, B)

    Shape13.FillColor = RGB(R, G, B)

    Shape14.FillColor = RGB(R, G, B)

    Shape15.FillColor = RGB(R, G, B)

    T1.BackColor = RGB(R, G, B)

    T2.BackColor = RGB(R, G, B)

    T3.BackColor = RGB(R, G, B)

    T4.BackColor = RGB(R, G, B)

    T5.BackColor = RGB(R, G, B)

    T6.BackColor = RGB(R, G, B)

    T7.BackColor = RGB(R, G, B)

    T8.BackColor = RGB(R, G, B)

    T9.BackColor = RGB(R, G, B)

    T10.BackColor = RGB(R, G, B)

    T11.BackColor = RGB(R, G, B)

    T12.BackColor = RGB(R, G, B)

    T13.BackColor = RGB(R, G, B)

    T14.BackColor = RGB(R, G, B)

    T15.BackColor = RGB(R, G, B)

End Sub



Public Sub LoadScore()

'Carica il punteggio massimo dal registro

    mpunt = GetSetting("PNUM", "SCORE", "HISCORE")

    mname = GetSetting("PNUM", "SCORE", "NSCORE")

    If mpunt = "" Then mpunt = 0 'Se non esiste alcun punteggio registrato imposta 0

    If mname = "" Then mname = "<Giocatore>" 'Se non esiste nessun nome registrato imposta la stringa

    HScore.Caption = mname & Chr(13) & mpunt

End Sub

<!--SPOILER DIV--></div><!--SPOILER DIV-->

frmAbout
<!--SPOILER BEGIN--><div class="spoilertop" onClick="openClose('e39a23237b60d7c9b485be3b8d0e3570')" style="font-weight: bold">Clicca per lo Spoiler!</div><div class="spoilermain" id="e39a23237b60d7c9b485be3b8d0e3570" style="display:none"><!--SPOILER END-->

CODICE

Dim Clicks As Integer



Private Sub Command1_Click()

    Unload Me

End Sub



Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)

    Select Case KeyCode

        Case vbKeyH: Image1_Click

        Case vbKeyEscape: Unload Me

    End Select

End Sub



Private Sub Form_Load()

    CF Me

    Clicks = 0

    lblVer.Caption = "Versione " & App.Major & "." & App.Minor & " revisione " & App.Revision

    Label2.Caption = "Autore: -DjGG-" & Chr(13) & _

                     "Data di creazione del progetto: 29/06/2009" & Chr(13) & _

                     "Beta tester: Patty" & Chr(13) & Chr(13) & "FREEWARE" & Chr(13) & Chr(13) & "Dedicato alla mia promessa sposa Samantha"

End Sub



Private Sub Image1_Click()

    If Clicks >= 5 Then

        inputstringa = InputBox("Inserisci il codice per attivare i trucchi", "ATTIVA TRUCCHI")

        If inputstringa = "0000" Then

            frmGame.Command1.Visible = True

            frmGame.Command2.Visible = True

            Clicks = 0

            Unload Me

        ElseIf inputstringa = "9995" Then

            SaveSetting "PNUM", "SCORE", "HISCORE", "0"

            SaveSetting "PNUM", "SCORE", "NSCORE", "<Giocatore>"

            frmGame.LoadScore

            MsgBox ("High Score resettato!"), vbExclamation, "RESET"

        Else

            MsgBox ("Codice non valido"), vbCritical, "TRUCCHI"

            Clicks = 0

            Unload Me

        End If

    Else

        Clicks = Clicks + 1

    End If

End Sub

<!--SPOILER DIV--></div><!--SPOILER DIV-->

Module1
<!--SPOILER BEGIN--><div class="spoilertop" onClick="openClose('b455c7b83b272819237b6ab4c1c91056')" style="font-weight: bold">Clicca per lo Spoiler!</div><div class="spoilermain" id="b455c7b83b272819237b6ab4c1c91056" style="display:none"><!--SPOILER END-->[code]Public Sub CF(fName As Form)

'Centra la finestra sullo schermo

fName.Left = (Screen.Width - fName.Width) / 2

fName.Top = (Screen.Height - fName.Height) / 2

End Sub
[/spoiler]

CONDIZIONI DI UTILIZZO
Potete modificare e studiare il codice che ho creato, il codice come potete vedere è ben commentato, sicuro e privo da virus. Se decidete di modificare il codice per creare una versione personalizzata della Piramide Numerica avete l'obbligo di indicare che la vostra versione è basata sul progetto originale di -DjGG- e dovete inviarmi una copia della versione modificata.

Grazie ancora a tutti per avere prestato attenzione a questo progetto e soprattutto grazie ai ragazzi di GBArl che hanno scovato alcuni bug!

[bernie]

veramente bello , ho fatto alcuone partite e mi sembra che ci siano ancora dei problemi nel record , ho fatto 165 punti e mi ha chiesto di inserire il nome , la partita seguente 45 e mi ha scritto come nuovo record 45
Aloha

[MISS!GNO]

Grande djgg
Molto ben fatto
EDIT:Il download della 2 beta non funziona più

[-Blaziken-]

sembra un bel gioco qualcuno faccia un porting per ds!