Never Mind

Vb.net non supporta gli array di controlli (si può bypassare il problema con una funzione che li crea run time ma in questo caso sarebbe uno sforzo superfluo e un buon hacker tende a evitare inutili sprechi di codice, di memoria, di byte, ridondanze, dispersioni, inefficienze) ho usato visual basic 3, un software uscito nel 1993, a 16 bit, più che sufficiente per scrivere questo giochino disponibile solo come oggetto di plastica quando ci giocavo da piccolo.

Se qualcuno sa scrivere un algoritmo migliore di questo me lo faccia avere, sarei felice di studiare una soluzione più efficiente della mia.

Il file Mind.bas contiene le definizioni globali

Global n, n2, postoz, colorez, tentativo As Integer
Global quantiX(1 To 8) As Integer 'quanti rossi/gialli in x, in che posizione
Global quantiXpos(1 To 8, 0 To 5) As Integer 'quanti rossi/gialli in x, in che posizione
Global quantiY(1 To 8) As Integer 'quanti rossi in picture
Global quantiYpos(1 To 8, 0 To 5) As Integer 'quanti rossi/gialli in x, in che posizione
Global posto(1 To 8) As Integer
Global colore(0 To 5) As Integer
Type opzioni_type
celle As Integer
colori As Integer
ripeti As Integer
End Type
Global opzioni As opzioni_type

Il form contiene un frame di opzioni, con due bottoni (ok e annulla) in array. Le opzioni scelte vengono salvate.

Sub Command2_Click (index As Integer)
If index = 0 Then
If opzioni.celle > opzioni.colori And opzioni.ripeti = 1 Then
MsgBox "Non si possono mettere " + Str(opzioni.colori) + " colori in " + Str(opzioni.celle) + " celle senza ripetere almeno un colore"
Exit Sub
End If
answer = MsgBox("Attenzione, il settaggio delle opzioni avvia una nuova partita. Continuo?", 4 + 32, "Settaggio opzioni")
If answer = 6 Then
opzioni.celle = hscroll1(0).Value
opzioni.colori = hscroll1(1).Value
If option1(0).Value = True Then
opzioni.ripeti = 0
Else
opzioni.ripeti = 1
End If
Open "mind.cfg" For Random As #1 Len = Len(opzioni)
Put #1, 1, opzioni
Close #1
Call gamenew_Click
End If
End If
frame1.Visible = False
End Sub

Il bottone ok analizza la soluzione proposta dal giocatore e ne comunica il grado di correttezza.

Sub Command3_Click ()
For n = 0 To opzioni.celle - 1
If Y(n).BackColor = &HFFFFFF Then
MsgBox "Non si possono lasciare caselle bianche", 48, "Completare scelta colori"
Exit Sub
End If
Next n
For n = 1 To 8 'azzera
For n2 = 0 To opzioni.celle - 1
quantiY(n) = 0: quantiYpos(n, n2) = 0
Next n2
posto(n) = 0
Next n
'quanti colori contiene?
For n = 0 To opzioni.celle - 1
Select Case Y(n).BackColor
Case &HFF&:
quantiY(1) = quantiY(1) + 1: quantiYpos(1, n) = 1
Case &H80FF&:
quantiY(2) = quantiY(2) + 1: quantiYpos(2, n) = 1
Case &HFFFF&:
quantiY(3) = quantiY(3) + 1: quantiYpos(3, n) = 1
Case &HFF00&:
quantiY(4) = quantiY(4) + 1: quantiYpos(4, n) = 1
Case &HFFFF00:
quantiY(5) = quantiY(5) + 1: quantiYpos(5, n) = 1
Case &HFF0000:
quantiY(6) = quantiY(6) + 1: quantiYpos(6, n) = 1
Case &HFF00FF:
quantiY(7) = quantiY(7) + 1: quantiYpos(7, n) = 1
Case &HC0C0C0:
quantiY(8) = quantiY(8) + 1: quantiYpos(8, n) = 1
End Select
Next n
'quanti colori azzeccati?
For n = 1 To 8 'colore al posto giusto
For n2 = 0 To opzioni.celle - 1 'posizione
If quantiXpos(n, n2) = quantiYpos(n, n2) And quantiXpos(n, n2) > 0 Then posto(n) = posto(n) + 1 'colore al posto giusto
Next n2
Next n
For n = 1 To 8 'colore al posto sbagliato
If quantiY(n) > quantiX(n) Then quantiY(n) = quantiX(n) 'se ce n'è di più che in base allora max base
If posto(n) > 0 Then quantiY(n) = quantiY(n) – posto(n) 'quelli al posto giusto non si ricontano
If quantiY(n) < 0 Then quantiY(n) = 0
Next n
'segna situazione
postoz = 0: colorez = 0
For n = 1 To 8
postoz = postoz + posto(n): colorez = colorez + quantiY(n)
Next n
For n = 0 + (tentativo * 6) To opzioni.celle - 1 + (tentativo * 6)
Z(n).BackColor = Y(n - (tentativo * 6)).BackColor: Z(n).Visible = True
Next n
Select Case postoz
Case 0:
If colorez > 0 Then
For n = 0 + (tentativo * 6) To colorez - 1 + (tentativo * 6)
shape1(n).BackColor = &HFFFFFF: shape1(n).Visible = True
Next n
End If
Case Else:
For n = 0 + (tentativo * 6) To (postoz - 1) + (tentativo * 6)
shape1(n).BackColor = &H0&: shape1(n).Visible = True
Next n
If colorez > 0 Then
For n = 0 + (tentativo * 6) To colorez - 1 + (tentativo * 6)
shape1(n + postoz).BackColor = &HFFFFFF: shape1(n + postoz).Visible = True
Next n
End If
End Select
'MsgBox Str(postoz) + " " + Str(opzioni.celle)
If postoz = opzioni.celle Then
Call vincita
Exit Sub
End If
tentativo = tentativo + 1
If tentativo = 15 Then
MsgBox "Tentativi a disposizione terminati", 48, "Fine partita"
For n = 0 To 5
x(n).Visible = True
Next n
Else
For n = 0 To opzioni.celle - 1
Y(n).BackColor = &HFFFFFF
Next n
End If
End Sub

All'avvio si inizializza e vengono gestite alcune chiamate.

Sub Form_Load ()
Open "mind.cfg" For Random As #1 Len = Len(opzioni)
Get #1, 1, opzioni
Close #1
If opzioni.celle < 4 Then
opzioni.celle = 4
opzioni.colori = 6
opzioni.ripeti = 0
Open "mind.cfg" For Random As #1 Len = Len(opzioni)
Put #1, 1, opzioni
Close #1
Call gameopz_Click
End If
End Sub
Sub gameexit_Click ()
End
End Sub
Sub gamenew_Click ()
tentativi = 0
For n = 0 To 5
x(n).Visible = False
Y(n).Visible = False
Next n
For n = 0 To 47
p1(n).Visible = False
Next n
For n = 0 To 89
Z(n).Visible = False
shape1(n).Visible = False
Next n
For n = 0 To opzioni.celle - 1
Y(n).Visible = True
Next n
For n = 0 To opzioni.celle * 8 - 1 Step 8
For n2 = 0 + n To opzioni.colori - 1 + n
p1(n2).Visible = True
Next n2
Next n
For n = 1 To 8
For n2 = 0 To 5
quantiX(n) = 0: quantiXpos(n, n2) = 0
Next n2
Next n
Randomize
rifa:
For n = 0 To opzioni.celle - 1
x(n).BackColor = p1(Int(Rnd * opzioni.colori)).BackColor
Next n
If opzioni.ripeti = 1 Then
For n = 0 To opzioni.celle - 1
For n2 = n + 1 To opzioni.celle - 1
If x(n).BackColor = x(n2).BackColor GoTo rifa
Next n2
Next n
End If
For n = 0 To opzioni.celle - 1'3
If x(n).BackColor = &HFF& Then 'rosso
quantiX(1) = quantiX(1) + 1: quantiXpos(1, n) = 1
End If
If x(n).BackColor = &H80FF& Then 'arancio
quantiX(2) = quantiX(2) + 1: quantiXpos(2, n) = 1
End If
If x(n).BackColor = &HFFFF& Then 'giallo
quantiX(3) = quantiX(3) + 1: quantiXpos(3, n) = 1
End If
If x(n).BackColor = &HFF00& Then 'verde
quantiX(4) = quantiX(4) + 1: quantiXpos(4, n) = 1
End If
If x(n).BackColor = &HFFFF00 Then 'azzurro
quantiX(5) = quantiX(5) + 1: quantiXpos(5, n) = 1
End If
If x(n).BackColor = &HFF0000 Then 'blu
quantiX(6) = quantiX(6) + 1: quantiXpos(6, n) = 1
End If
If x(n).BackColor = &HFF00FF Then 'VIOLA
quantiX(7) = quantiX(7) + 1: quantiXpos(7, n) = 1
End If
If x(n).BackColor = &HC0C0C0 Then 'GRIGIO
quantiX(8) = quantiX(8) + 1: quantiXpos(8, n) = 1
End If
Next n
command3.Enabled = True
End Sub
Sub gameopz_Click ()
frame1.Visible = True
hscroll1(0).Value = opzioni.celle
hscroll1(1).Value = opzioni.colori
label2(0) = hscroll1(0).Value
label2(1) = hscroll1(1).Value
option1(opzioni.ripeti).Value = True
End Sub
Sub HScroll1_Change (index As Integer)
label2(index) = hscroll1(index).Value
End Sub
Sub P1_Click (index As Integer)
Y(Int(index / 8)).BackColor = p1(index).BackColor
End Sub
Sub vincita ()
For n = 0 To opzioni.celle - 1
x(n).Visible = True
Next n
MsgBox "Hai vinto in " + Str(tentativo) + " tentativi!", 48, "Complimenti"
command3.Enabled = False
End Sub