12/03 10:51
maurizio74
Ciao a tutti, provando ad implementare il calcolo enigmatico che avevo posto quache giorno fa, di cui Carlo mi ha dato una grande mano, mi sono accorto che il programma ha qualche falla nel senso che non funge come dovrebbe:
questo è il codice funzionante del programma realizzato con 5 numeri:
Dim fatto As Boolean
Private Sub Command1_click()
Dim i As Long
Dim arr(1 To 5) As Variant
fatto = False ' azzera la variabile booleana
For i = 1 To 5
arr(i) = i
Next
Call permutazioni(arr, 5, 5)
End Sub
Sub permutazioni(vettore() As Variant, dimensione As Long, n As Long)
Dim i As Long
If fatto Then Exit Sub ' termina la ricorsione
If dimensione = 1 Then
fatto = risultato(vettore) ' memorizzo in fatto il valore booleano
Exit Sub
End If
For i = 1 To dimensione
Call permutazioni(vettore(), dimensione - 1, n)
If dimensione Mod 2 = 1 Then
Call Scambio(vettore(), 1, dimensione)
Else
Call Scambio(vettore(), i, dimensione)
End If
Next
End Sub
Sub Scambio(arr() As Variant, indice1 As Long, indice2 As Long)
Dim temp_var As Variant
temp_var = arr(indice1)
arr(indice1) = arr(indice2)
arr(indice2) = temp_var
End Sub
Function risultato(vettore()) As Boolean
Dim value As Integer ' conterrà la somma delle uguaglianze
' riempimento Text (celle)
TextO1 = vettore(1)
TextO2 = vettore(2)
TextO3 = vettore(3)
TextO4 = vettore(4)
TextO5 = vettore(5)
Text01 = vettore(1)
Text02 = vettore(2)
Text03 = vettore(3)
Text04 = vettore(4)
Text05 = vettore(5)
' riga 4
TextC4 = TextO1
TextD4 = TextO2
TextF4 = TextO3
TextI4 = TextO1
TextJ4 = TextO4
' riga 7
TextD7 = TextO2
TextF7 = TextO4
TextJ7 = TextO3
'riga10
TextD10 = TextO3
TextF10 = TextO1
TextJ10 = TextO5
' verifica
' riga 14
TextD14 = TextC4 & TextD4
TextF14 = TextF4
TextH14 = TextI4 & TextJ4
If CInt(TextD14) - CInt(TextF14) - CInt(TextH14) = 0 Then TextJ14 = "VERO": value = value + 1 Else TextJ14 = "FALSO"
' riga 15
TextD15 = TextD7
TextF15 = TextF7
TextH15 = TextJ7
If CInt(TextD15) - CInt(TextF15) - CInt(TextH15) = 0 Then TextJ15 = "VERO": value = value + 1 Else TextJ15 = "FALSO"
' riga 16
TextD16 = TextD10
TextF16 = TextF10
TextH16 = TextJ10
If CInt(TextD16) + CInt(TextF16) - CInt(TextH16) = 0 Then TextJ16 = "VERO": value = value + 1 Else TextJ16 = "FALSO"
' riga 17
TextD17 = TextC4 & TextD4
TextF17 = TextD7
TextH17 = TextD10
If CInt(TextD17) - CInt(TextF17) * CInt(TextH17) = 0 Then TextJ17 = "VERO": value = value + 1 Else TextJ17 = "FALSO"
' riga 18
TextD18 = TextF4
TextF18 = TextF7
TextH18 = TextF10
If CInt(TextD18) - CInt(TextF18) - CInt(TextH18) = 0 Then TextJ18 = "VERO": value = value + 1 Else TextJ18 = "FALSO"
' riga 19
TextD19 = TextI4 & TextJ4
TextF19 = TextJ7
TextH19 = TextJ10
If CInt(TextD19) - CInt(TextF19) * CInt(TextH19) = 0 Then TextJ19 = "VERO": value = value + 1 Else TextJ19 = "FALSO"
' riga 20
TextJ20 = value
If TextJ20 = 6 Then
risultato = True
Else
risultato = False
End If
DoEvents ' per vedere la progressione
End Function
ed in allegato la foto dei textbox disposti nel programma.
questo è il codice funzionante del programma realizzato con 5 numeri:
Dim fatto As Boolean
Private Sub Command1_click()
Dim i As Long
Dim arr(1 To 5) As Variant
fatto = False ' azzera la variabile booleana
For i = 1 To 5
arr(i) = i
Next
Call permutazioni(arr, 5, 5)
End Sub
Sub permutazioni(vettore() As Variant, dimensione As Long, n As Long)
Dim i As Long
If fatto Then Exit Sub ' termina la ricorsione
If dimensione = 1 Then
fatto = risultato(vettore) ' memorizzo in fatto il valore booleano
Exit Sub
End If
For i = 1 To dimensione
Call permutazioni(vettore(), dimensione - 1, n)
If dimensione Mod 2 = 1 Then
Call Scambio(vettore(), 1, dimensione)
Else
Call Scambio(vettore(), i, dimensione)
End If
Next
End Sub
Sub Scambio(arr() As Variant, indice1 As Long, indice2 As Long)
Dim temp_var As Variant
temp_var = arr(indice1)
arr(indice1) = arr(indice2)
arr(indice2) = temp_var
End Sub
Function risultato(vettore()) As Boolean
Dim value As Integer ' conterrà la somma delle uguaglianze
' riempimento Text (celle)
TextO1 = vettore(1)
TextO2 = vettore(2)
TextO3 = vettore(3)
TextO4 = vettore(4)
TextO5 = vettore(5)
Text01 = vettore(1)
Text02 = vettore(2)
Text03 = vettore(3)
Text04 = vettore(4)
Text05 = vettore(5)
' riga 4
TextC4 = TextO1
TextD4 = TextO2
TextF4 = TextO3
TextI4 = TextO1
TextJ4 = TextO4
' riga 7
TextD7 = TextO2
TextF7 = TextO4
TextJ7 = TextO3
'riga10
TextD10 = TextO3
TextF10 = TextO1
TextJ10 = TextO5
' verifica
' riga 14
TextD14 = TextC4 & TextD4
TextF14 = TextF4
TextH14 = TextI4 & TextJ4
If CInt(TextD14) - CInt(TextF14) - CInt(TextH14) = 0 Then TextJ14 = "VERO": value = value + 1 Else TextJ14 = "FALSO"
' riga 15
TextD15 = TextD7
TextF15 = TextF7
TextH15 = TextJ7
If CInt(TextD15) - CInt(TextF15) - CInt(TextH15) = 0 Then TextJ15 = "VERO": value = value + 1 Else TextJ15 = "FALSO"
' riga 16
TextD16 = TextD10
TextF16 = TextF10
TextH16 = TextJ10
If CInt(TextD16) + CInt(TextF16) - CInt(TextH16) = 0 Then TextJ16 = "VERO": value = value + 1 Else TextJ16 = "FALSO"
' riga 17
TextD17 = TextC4 & TextD4
TextF17 = TextD7
TextH17 = TextD10
If CInt(TextD17) - CInt(TextF17) * CInt(TextH17) = 0 Then TextJ17 = "VERO": value = value + 1 Else TextJ17 = "FALSO"
' riga 18
TextD18 = TextF4
TextF18 = TextF7
TextH18 = TextF10
If CInt(TextD18) - CInt(TextF18) - CInt(TextH18) = 0 Then TextJ18 = "VERO": value = value + 1 Else TextJ18 = "FALSO"
' riga 19
TextD19 = TextI4 & TextJ4
TextF19 = TextJ7
TextH19 = TextJ10
If CInt(TextD19) - CInt(TextF19) * CInt(TextH19) = 0 Then TextJ19 = "VERO": value = value + 1 Else TextJ19 = "FALSO"
' riga 20
TextJ20 = value
If TextJ20 = 6 Then
risultato = True
Else
risultato = False
End If
DoEvents ' per vedere la progressione
End Function
ed in allegato la foto dei textbox disposti nel programma.
Ultima modifica effettuata da maurizio74 12/03 10:53
aaa