Imports System.IO
Imports System.Threading
'***************************************************************************************************
' Programma per la soluzione del Sudoku realizzato da *** Tebaldo Ulleri *** in Data 11-Aprile-2018. ***
'***************************************************************************************************
Public Class Sudoku_Solver
'***********************************************************************************************
' Variabili Globali
'***********************************************************************************************
Public CelleSudoku() As Button = {}
Friend nRow As Int32 = 9
Friend nCol As Int32 = 9
Friend nBaseSudoku As Int32 = 9
Friend numeriSchemaSdku As Int32
Public MSudoku(nRow, nCol) As Int32
Public SchemaBase(nRow, nCol) As Int32
Public DictCaselle
As New Dictionary(Of
String, Casella
)
Friend npRemovables(,) As List(Of Int32)
Friend smPossibili(,) As List(Of Int32)
Public StatoEventi As Int32
Public Esci As Boolean = False
'*************************************************************
Sub New()
' Chiamata richiesta dalla finestra di progettazione.
InitializeComponent()
' Aggiungere le eventuali istruzioni di inizializzazione dopo la chiamata a InitializeComponent().
End Sub
Private Sub Sudoku_Solver_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load
Call Inizializza(MSudoku, nRow, nCol)
Call CreaSudoku3X3Classic()
StatoEventi = Stato.Iniziale
End Sub
Public Sub Inizializza(ByRef MatrSudoku(,) As Int32, ByVal r As Int32, ByVal c As Int32)
Dim BaseSudoku = r
ReDim smPossibili(BaseSudoku, BaseSudoku)
ReDim npRemovables(BaseSudoku, BaseSudoku)
Dim nbase As Int32 = BaseSudoku
DictCaselle.Clear()
For i As Int32 = 1 To r
For j As Int32 = 1 To c
'Inizializza Caselle.
Dim pos As String = i.ToString & "-" & j.ToString
DictCaselle.Add(pos, New Casella)
Dim Casel As Casella
Casel.NomeCasella = pos
Casel.Numero = 0
Casel.StatoCasella = Stato.Vuoto
Casel.RigaCasella = i
Casel.ColonnaCasella = j
Casel.QuadroCasella = RitornaQuadrante(i, j, nbase)(4)
Casel.nObbligato = Nothing
Casel.NcasiPossibili = BaseSudoku
Dim Lstpossib As New List(Of Int32)
Dim LstRemovables As New List(Of Int32)
For nk As Int32 = 1 To BaseSudoku
Lstpossib.Add(nk)
Next nk
smPossibili(i, j) = Lstpossib.ToList
npRemovables(i, j) = LstRemovables.ToList
Casel.CasiPossibili = " ? " 'RitornaNumPossibili(MatrSudoku, i, j, nbase, Casel.NomeCasella)
Casel.Eliminabili = "0"
Casel.LstCasiPossibili = Lstpossib.ToList
DictCaselle(pos) = Casel
Next j
Next i
End Sub
Public Sub CreaSudoku3X3Classic()
Panel1.Controls.Clear()
ReDim CelleSudoku(81)
Dim xP, yP, nCel As Integer
xP = 20
yP = 20
nCel = 0
For i As Int32 = 1 To 9 Step +1
xP = 20
For j As Int32 = 1 To 9 Step +1
nCel += 1
CelleSudoku(nCel) = New Button
CelleSudoku(nCel).AutoSize = False
CelleSudoku(nCel).TextAlign = ContentAlignment.MiddleCenter
CelleSudoku(nCel).Font = New System.Drawing.Font("Arial", 12, FontStyle.Bold)
CelleSudoku(nCel).Size = New System.Drawing.Size(40, 40)
CelleSudoku(nCel).Location = New System.Drawing.Point(xP, yP)
CelleSudoku(nCel).BackColor = Color.Ivory
CelleSudoku(nCel).ForeColor = Color.Maroon
CelleSudoku(nCel).Name = "Cella_" & i.ToString & "-" & j.ToString
CelleSudoku(nCel).Text = j.ToString
CelleSudoku(nCel).Tag = (i).ToString & "-" & (j).ToString
CelleSudoku(nCel).FlatStyle = FlatStyle.Flat
'CelleSudoku(nCel).ContextMenuStrip = CMenuStripInfo
AddHandler CelleSudoku(nCel).Click, AddressOf Evento1DownClick
AddHandler CelleSudoku(nCel).MouseWheel, AddressOf Evento1UPClick
AddHandler CelleSudoku(nCel).MouseEnter, AddressOf InfoCasella
AddHandler CelleSudoku(nCel).KeyPress, AddressOf EventoKeyboardClick
Panel1.Controls.Add(CelleSudoku(nCel))
If nCel Mod 3 = 0 Then
xP = xP + 49
Else
xP = xP + 42
End If
Next j
If i Mod 3 = 0 Then
yP = yP + 49
Else
yP = yP + 42
End If
Next i
nRow = 9
nCol = 9
nBaseSudoku = 9
ReDim MSudoku(nRow, nCol)
End Sub
Friend Sub InfoCasella(ByVal sender As Object, ByVal e As EventArgs)
' casting dell'ogetto...
Dim Btn As Control = DirectCast(sender, Control)
Me.TStripTBoxInfo.Text = "Informazioni " & Btn.Name.ToString & " = " & Btn.Tag
Btn.Focus()
End Sub
Private Sub Evento1UPClick(ByVal sender As Object, ByVal e As EventArgs)
' casting dell'ogetto...
Dim Btn As Control = DirectCast(sender, Control)
Select Case Btn.Text
Case ""
Btn.Text = "1"
Case "1"
Btn.Text = "2"
Case "2"
Btn.Text = "3"
Case "3"
Btn.Text = "4"
Case "4"
Btn.Text = "5"
Case "5"
Btn.Text = "6"
Case "6"
Btn.Text = "7"
Case "7"
Btn.Text = "8"
Case "8"
Btn.Text = "9"
Case "9"
Btn.Text = ""
End Select
End Sub
Private Sub Evento1DownClick(ByVal sender As Object, ByVal e As EventArgs)
' casting dell'ogetto...
Dim Btn As Control = DirectCast(sender, Control)
Select Case Btn.Text
Case ""
Btn.Text = "9"
Case "1"
Btn.Text = ""
Case "2"
Btn.Text = "1"
Case "3"
Btn.Text = "2"
Case "4"
Btn.Text = "3"
Case "5"
Btn.Text = "4"
Case "6"
Btn.Text = "5"
Case "7"
Btn.Text = "6"
Case "8"
Btn.Text = "7"
Case "9"
Btn.Text = "8"
End Select
Me.TStripCoBoxInfo.Items.Clear()
End Sub
Private Sub Evento2UPClick(ByVal sender As Object, ByVal e As EventArgs)
' casting dell'ogetto...
Dim Btn As Control = DirectCast(sender, Control)
Select Case Btn.Text
Case ""
Btn.Text = "1"
Case "16"
Btn.Text = ""
Exit Sub
Case Is <> ""
Dim nx As Byte = CByte(Btn.Text)
If nx < 16 Then nx += 1
Btn.Text = nx.ToString
End Select
End Sub
Private Sub EventoKeyboardClick(ByVal sender As Object, ByVal e As KeyPressEventArgs) 'Handles Me.KeyPress
' casting dell'ogetto...
Dim Btn As Control = DirectCast(sender, Control)
Select Case Btn.Text
Case ""
If e.KeyChar >= ChrW(48) And e.KeyChar <= ChrW(57) Then
Btn.Text = e.KeyChar.ToString
Else
Btn.Text = ""
End If
Case Is <> ""
If e.KeyChar >= ChrW(48) And e.KeyChar <= ChrW(57) Then
Btn.Text += e.KeyChar.ToString
Else
Btn.Text = ""
End If
End Select
End Sub
Private Sub Evento2DownClick(ByVal sender As Object, ByVal e As EventArgs)
' casting dell'ogetto...
Dim Btn As Control = DirectCast(sender, Control)
Select Case Btn.Text
Case ""
Btn.Text = "16"
Case "1"
Btn.Text = ""
Exit Sub
Case Is <> ""
Dim nx As Byte = CByte(Btn.Text)
If nx > 1 Then nx -= 1
Btn.Text = nx.ToString
End Select
Me.TStripCoBoxInfo.Items.Clear()
End Sub
Private Sub ClearToolStripMenuItem_Click(sender As Object, e As EventArgs) Handles ClearToolStripMenuItem.Click
Call ResettaSudoKu(nRow, nCol)
Tstato_eventi.Text = "Status: "
Tstato_eventi.Text &= (" New Sudoku... ")
End Sub
Friend Sub ResettaSudoKu(ByRef nRow As Int32, ByRef nCol As Int32)
Try
Call ClearSudoku()
For i As Int32 = 1 To nRow
For j As Int32 = 1 To nCol
MSudoku(i, j) = Nothing
Next j
Next i
StatoEventi = Stato.Iniziale
Catch ex As Exception
MsgBox(ex.Message & " [OK] ", MsgBoxStyle.Information)
End Try
End Sub
Friend Sub ClearSudoku()
For Each btn As Control In Panel1.Controls
btn.Text = ""
btn.Enabled = True
btn.BackColor = Color.Ivory
btn.ForeColor = Color.Maroon
Next btn
Application.DoEvents()
End Sub
Private Sub ConfermaSchemaToolStripMenuItem_Click(sender As Object, e As EventArgs) Handles ConfermaSchemaToolStripMenuItem.Click
If StatoEventi = Stato.Iniziale Then
Call Inizializza(MSudoku, nRow, nCol)
Call ConfermaSudoku()
End If
End Sub
Public Sub ConfermaSudoku()
ReDim MSudoku(nRow, nCol)
nBaseSudoku = nRow
numeriSchemaSdku = 0
For i As Int32 = 1 To nRow
For j As Int32 = 1 To nCol
Dim pos As String = i.ToString & "-" & j.ToString
For Each btn As Control In Panel1.Controls
If btn.Tag = pos Then
If btn.Text.Trim <> "" Then
MSudoku(i, j) = CInt(btn.Text.Trim)
numeriSchemaSdku += 1
Else
MSudoku(i, j) = Nothing
End If
End If
Next btn
Next j
Next i
If VerSudokuIniziale(MSudoku, nBaseSudoku) = False Then
StatoEventi = Stato.Impossibile
MsgBox(" Sudoku Impossibile! controllare i numeri. ", MsgBoxStyle.Information, "Nupero Ripetuto!")
Else
Tstato_eventi.Text = (" Schema Sudoku Confermato... Numeri schema: " & numeriSchemaSdku)
StatoEventi = Stato.Confermato
'Preparo lo schema base per un eventuale ripristino.
ReDim SchemaBase(nRow, nCol)
SchemaBase = MSudoku.Clone
End If
For Each btn As Control In Panel1.Controls
If btn.Text.Trim <> "" Then
btn.ForeColor = Color.Red
btn.BackColor = Color.MediumTurquoise
btn.Enabled = False
Else
btn.BackColor = Color.NavajoWhite
End If
Next btn
End Sub
Public Function VerSudokuIniziale(ByRef matrSbase(,) As Int32, ByVal bs As Int32, Optional ByVal noerr As Boolean = False) As Boolean
Dim flag As Boolean = True
Dim r As Int32 = bs
Dim c As Int32 = bs
For i As Int32 = 1 To r Step +1
For j As Int32 = 1 To c Step +1
If VerColonna(matrSbase, 1, j, bs, noerr) = False Then
flag = False
Return flag
End If
If VerQuadro(matrSbase, i, j, bs, noerr) = False Then
flag = False
Return flag
End If
Next j
If VerRiga(matrSbase, i, 1, bs, noerr) = False Then
flag = False
Return flag
End If
Next i
Return flag
End Function
Public Function VerQuadro(ByRef matrS(,) As Int32, ByVal r As Int32, ByVal c As Int32, ByVal bs As Int32, Optional ByVal noerr As Boolean = False) As Boolean
'Ricerca riquadro sudoku.
Dim LstVerQ As New List(Of Int32)
Dim flag As Boolean = True
'valore base.
Dim vb As Int32 = Math.Sqrt(bs)
'ricerca coordinate riquadro.
Dim ax As Int32
Dim ay As Int32
Dim bx As Int32
Dim by As Int32
For a As Int32 = r To bs
If a Mod vb = 0 Then
ay = a
Exit For
End If
Next a
ax = (ay - vb) + 1
For b As Int32 = c To bs
If b Mod vb = 0 Then
by = b
Exit For
End If
Next b
bx = (by - vb) + 1
'verifico i numeri presenti nel riquadro.
For z As Int32 = ax To ay
For k As Int32 = bx To by
If matrS(z, k) = 0 Then
Dim knc As String = z.ToString & "-" & k.ToString
Dim cas As Casella
cas = DictCaselle(knc)
cas.StatoCasella = Stato.Vuoto
DictCaselle(knc) = cas
End If
If matrS(z, k) > 0 Then
If LstVerQ.Contains(matrS(z, k)) = False Then
LstVerQ.Add(matrS(z, k))
Else
flag = False
If noerr Then Return flag
Dim knc As String = z.ToString & "-" & k.ToString
Dim cas As Casella
cas = DictCaselle(knc)
If Not DictCaselle(knc).StatoCasella = Stato.Fisso Then
cas.StatoCasella = Stato.Errato
DictCaselle(knc) = cas
'matrS(z, k) = 0
Else
Dim err As Int32
= matrS
(z, k
)
For z2 As Int32 = ax To ay
For k2 As Int32 = bx To by
Dim knc2 As String = z2.ToString & "-" & k2.ToString
If (Not DictCaselle
(knc2
).
StatoCasella = Stato.
Fisso) And (matrS
(z2, k2
) = err) Then
cas = DictCaselle(knc2)
cas.StatoCasella = Stato.Errato
DictCaselle(knc2) = cas
'matrS(z2, k2) = 0
End If
Next k2
Next z2
End If
End If
End If
Next k
Next z
Return flag
End Function
Public Function RitornaQuadrante(ByVal r As Int32, ByVal c As Int32, ByVal bs As Int32) As Int32()
Dim ValoriQ As Int32() = {1, 2, 3, 4, 5}
'valore base.
Dim vb As Int32 = Math.Sqrt(bs)
'ricerca coordinate riquadro.
Dim ax As Int32
Dim ay As Int32
Dim bx As Int32
Dim by As Int32
For a As Int32 = r To bs
If a Mod vb = 0 Then
ay = a
Exit For
End If
Next a
ax = (ay - vb) + 1
For b As Int32 = c To bs
If b Mod vb = 0 Then
by = b
Exit For
End If
Next b
bx = (by - vb) + 1
Dim Qp1 As Int32 = CInt(((by - 1) / vb))
Dim Qp2 As Int32 = CInt((((ay - 1) / vb) * vb))
Dim Q As Int32 = CInt(Qp1 + Qp2 + 1) - vb
ValoriQ(0) = ax
ValoriQ(1) = ay
ValoriQ(2) = bx
ValoriQ(3) = by
ValoriQ(4) = Q
Return ValoriQ
End Function
Public Function VerRiga(ByRef matrS(,) As Int32, ByVal r As Int32, ByVal c As Int32, ByVal bs As Int32, Optional ByVal noerr As Boolean = False) As Boolean
'Ricerca Riga sudoku.
Dim LstVerR As New List(Of Int32)
Dim flag As Boolean = True
'verifico i numeri presenti nella Riga.
For z As Int32 = 1 To bs
If matrS(r, z) = 0 Then
Dim knc As String = r.ToString & "-" & z.ToString
Dim cas As Casella
cas = DictCaselle(knc)
cas.StatoCasella = Stato.Vuoto
DictCaselle(knc) = cas
End If
If matrS(r, z) > 0 Then
If LstVerR.Contains(matrS(r, z)) = False Then
LstVerR.Add(matrS(r, z))
Else
flag = False
If noerr Then Return flag
Dim knc As String = r.ToString & "-" & z.ToString
Dim cas As Casella
cas = DictCaselle(knc)
If Not DictCaselle(knc).StatoCasella = Stato.Fisso Then
cas.StatoCasella = Stato.Errato
DictCaselle(knc) = cas
'matrS(r, z) = 0
Else
Dim err As Int32
= matrS
(r, z
)
For z2 As Int32 = 1 To bs
Dim knc2 As String = r.ToString & "-" & z2.ToString
If (Not DictCaselle
(knc2
).
StatoCasella = Stato.
Fisso) And (matrS
(r, z2
) = err) Then
cas = DictCaselle(knc2)
cas.StatoCasella = Stato.Errato
DictCaselle(knc2) = cas
'matrS(r, z2) = 0
End If
Next z2
End If
End If
End If
Next z
Return flag
End Function
Public Function VerColonna(ByRef matrS(,) As Int32, ByVal r As Int32, ByVal c As Int32, ByVal bs As Int32, Optional ByVal noerr As Boolean = False) As Boolean
'Ricerca Colonna sudoku.
Dim LstVerC As New List(Of Int32)
Dim flag As Boolean = True
'verifico i numeri presenti nella Colonna.
For z As Int32 = 1 To bs
If matrS(z, c) = 0 Then
Dim knc As String = z.ToString & "-" & c.ToString
Dim cas As Casella
cas = DictCaselle(knc)
cas.StatoCasella = Stato.Vuoto
DictCaselle(knc) = cas
End If
If matrS(z, c) > 0 Then
If LstVerC.Contains(matrS(z, c)) = False Then
LstVerC.Add(matrS(z, c))
Else
flag = False
If noerr Then Return flag
Dim knc As String = z.ToString & "-" & c.ToString
Dim cas As Casella
cas = DictCaselle(knc)
If Not DictCaselle(knc).StatoCasella = Stato.Fisso Then
cas.StatoCasella = Stato.Errato
DictCaselle(knc) = cas
'matrS(z, c) = 0
Else
Dim err As Int32
= matrS
(z, c
)
For z2 As Int32 = 1 To bs
Dim knc2 As String = z2.ToString & "-" & c.ToString
If (Not DictCaselle
(knc2
).
StatoCasella = Stato.
Fisso) And (matrS
(z2, c
) = err) Then
cas = DictCaselle(knc2)
cas.StatoCasella = Stato.Errato
DictCaselle(knc2) = cas
'matrS(z2, c) = 0
End If
Next z2
End If
End If
End If
Next z
Return flag
End Function
'#####################################################################
'Enumeratori
Enum Stato
Iniziale 'index 0
Vuoto
Confermato
Fisso
Risolto
Impossibile
Errato
Mobile
Obbligato
Pieno
Completo
Solving 'index 11
End Enum
'#########################################################
'Strutture.
Structure Casella
Dim QuadroCasella As Int32
Dim RigaCasella As Int32
Dim ColonnaCasella As Int32
Dim Numero As Int32
Dim nObbligato As Int32
Dim NcasiPossibili As Int32
Dim StatoCasella As Int32
Dim LstCasiPossibili As List(Of Int32)
Dim CasiPossibili As String
Dim Eliminabili As String
Dim NomeCasella As String
End Structure
Structure Riga
Dim NomeRiga As String
Dim NumeroRiga As Int32
Dim StatoRiga As Int32
Dim qNumeriR As Int32
Dim nPossibiliRiga As String
Dim LstPresentiRiga As List(Of Int32)
End Structure
Structure Colonna
Dim NomeColonna As String
Dim NumeroColonna As Int32
Dim StatoColonna As Int32
Dim qNumeriC As Int32
Dim nPossibiliColonna As String
Dim LstPresentiColonna As List(Of Int32)
End Structure
Structure QuadroX
Dim NomeQuadro As String
Dim NumeroQuadro As Int32
Dim StatoQuadro As Int32
Dim qNumeriQ As Int32
Dim nPossibiliQuadro As String
Dim LstPresentiQuadro As List(Of Int32)
End Structure
Public Function VerSudokuCompletato(ByRef matrS(,) As Int32, ByVal bs As Int32, Optional ByVal noerr As Boolean = False) As Boolean
Dim flag As Boolean = True
Dim r = bs
Dim c = bs
If VerZeroVuoti(matrS, bs) = False Then
flag = False
End If
If VerSudokuIniziale(matrS, bs, noerr) = False Then
flag = False
End If
Return flag
End Function
Public Function VerZeroVuoti(ByRef matrS(,) As Int32, ByVal bs As Int32) As Boolean
Dim flag As Boolean = True
Dim r = bs
Dim c = bs
For i As Int32 = 1 To r
For j As Int32 = 1 To c
If matrS(i, j) = 0 Then
flag = False
End If
Next j
Next i
Return flag
End Function
Friend Sub Presenta_Sudoku(ByVal MSudokuSchema As Int32(,), Optional ByVal Enab As Boolean = False)
Dim SingleLinePos As Int32
'presentazione dei numeri
SingleLinePos = 0
For CC As Byte = 1 To nRow
For kk As Byte = 1 To nCol
Dim pos As String = CC.ToString & "-" & kk.ToString
For Each btn As Control In Panel1.Controls
If btn.Tag = pos Then
If btn.Enabled = True Then
btn.Text = IIf(MSudokuSchema(CC, kk) <> 0, MSudokuSchema(CC, kk), "")
If btn.Text <> "" Then
btn.BackColor = Color.Orange
btn.ForeColor = Color.Black
'btn.Enabled = False
End If
End If
End If
Next btn
SingleLinePos += 1
Next kk
Next CC
'inserisco lo schema nella lista schemi.
'LstSchemiUnicaSoluzione.Add(MSudoku)
End Sub
Private Sub RisolviSudokuToolStripMenuItem_Click(sender As Object, e As EventArgs) Handles RisolviSudokuToolStripMenuItem.Click
'Avvia algoritmo solutivo.
If Not StatoEventi = Stato.Confermato Then
MsgBox(" Attenzione Confermare lo Schema Sudoku! " + Environment.NewLine + Environment.NewLine +
" Confirmation scheme Sudoku! ", MsgBoxStyle.Information)
Exit Sub
End If
Dim crono As New Stopwatch
'instanziamo la classe del Dansing-Links-Solver
Dim DLS As New Donald_Knuth_Dancing_Links_Solver(nBaseSudoku)
Me.ProgressBar1.Value = ProgressBar1.Maximum
Dim MultiS As Boolean = False
Dim np As Int32 = 1 'CInt(Me.Numero_percorsi.Text)
Dim nth As Int32 = 128 'CInt(Me.Numero_Threads.Text)
If Multi_Schema.Checked Then MultiS = True
crono.Start()
'utilizziaing-Links-Solver.
DLS.RisolviSudoku_DLX_Solver(MSudoku, nth, np, Esci, MultiS)
crono.Stop()
'recupero la soluzione.
'DLS.RitornaSoluzione(MSudoku)
'se lo schema è stato generato senza errori
If VerSudokuCompletato(MSudoku, nBaseSudoku) = True Then
'presento lo schema
Presenta_Sudoku(MSudoku)
Tstato_eventi.Text = "Status: Solve "
StatoEventi = Stato.Risolto
End If
'P.A.R. = Profondità Albero di Ricerca.
Tstato_eventi.Text += " Crono DLX= " & (crono.ElapsedMilliseconds / 1000) & " P.A.R. " & DLS.UltimoLivelloProfondità Raggiunto & "/" & DLS.MaxProfondità Ricerca
Me.ProgressBar1.Value = ProgressBar1.Minimum
Application.DoEvents()
'verifica dei valori delle variabili.
Try
MsgBox("Ultimo index raggiunto scala dei vincoli per tentativi = " & DLS.IndexUltimoRaggiuntoVettoreTentativi _
& vbNewLine & " Massimo index raggiunto scala dei vincoli per tentativi = " & DLS.IndexMaxRaggiuntoVettoreTentativi _
& vbNewLine & " Numero Totale index del vettore scala dei vincoli per tentativi = " & DLS.M_PT(0, 0) _
& vbNewLine & " Numero Totale di vincoli in esame scansionati = " & DLS.NumeroTotale_vincoli_in_esame_scansionati _
& vbNewLine & " Numero Totale di salti Back nei Tentativi = " & DLS.NumeroTotale_Salti_Back _
& vbNewLine & " Numero utilizzo Funzione (Mischia vettore scala dei vincoli) = " & DLS.Mischiate _
& vbNewLine & " Numero di Thread avviati col Multithreading = " & DLS.Thread_avviati _
& vbNewLine & " Numero del Thread solutivo = " & DLS.Numero_del_Thread_solutivo _
& vbNewLine & " Numero livelli raggiunto dalla profondià ricerca del Thread = " & DLS.UltimoLivelloProfondità Raggiunto _
& vbNewLine & " Numero dell'ultimo index del vettore scala dei vincoli per tentativi, raggiunto dal Thread = " & DLS.MaxProfondità Ricerca _
& vbNewLine & " Elenco dei vincoli bloccanti: " & vbNewLine, MsgBoxStyle.Information)
FormLog.Show()
FormLog.ListBoxLog.Items.Add("")
FormLog.ListBoxLog.Items.Add(" Elenco dei vincoli bloccanti: ")
For Each vincolo As String In DLS.ElencoVincolibloccanti.Keys
FormLog.ListBoxLog.Items.Add(vincolo & " uscito= " & DLS.ElencoVincolibloccanti(vincolo))
Next
FormLog.ListBoxLog.Items.Add("")
FormLog.ListBoxLog.Items.Add(" Elenco sequenza index lista vincoli per tentativi: ")
For Each indxv As String In DLS.Sequenza_index_vincoli
FormLog.ListBoxLog.Items.Add("index vincolo + candidato= " & indxv)
Next
Catch ex As Exception
MsgBox(" Risolto senza Backtracking.", MsgBoxStyle.Information)
End Try
End Sub
Private Sub StopLoopToolStripMenuItem_Click(sender As Object, e As EventArgs) Handles StopLoopToolStripMenuItem.Click
Esci = True
Application.DoEvents()
End Sub
Private Sub RipristinaSchemaInizialeToolStripMenuItem_Click(sender As Object, e As EventArgs) Handles RipristinaSchemaInizialeToolStripMenuItem.Click
Call RipristinaIniziale(SchemaBase, nRow, nCol)
End Sub
Public Sub RipristinaIniziale(ByVal matrSchema(,) As Int32, ByVal M_row As Int32, ByVal M_col As Int32)
Select Case StatoEventi
Case Stato.Confermato, Stato.Risolto, Stato.Impossibile, Stato.Vuoto
For i As Int32 = 1 To M_row
For j As Int32 = 1 To M_col
Dim pos As String = i.ToString & "-" & j.ToString
For Each btn As Control In Panel1.Controls
If btn.Tag = pos Then
btn.Enabled = True
btn.BackColor = Color.Ivory
btn.ForeColor = Color.Maroon
If matrSchema(i, j) > 0 Then
btn.Text = matrSchema(i, j).ToString
Else
btn.Text = ""
End If
End If
Next btn
Next j
Next i
StatoEventi = Stato.Iniziale
Tstato_eventi.Text = "Status: Sudoku Ripristinato "
Case Else
Return
End Select
End Sub
'#################################################################################################################################
End Class