Here's the class in it's entirety:
To use it, simply make a new instance and handle the BoardGenerated() event. Which gives you a 9x9 grid of the entire thing.Code:Option Explicit On Option Strict On Friend Class SudokuBoard Private WithEvents bw As New System.ComponentModel.BackgroundWorker Private m_TheBoard(8I, 8I) As Integer Private m_Numbers(8, 8) As List(Of Integer) Private Rand As New Random Friend Event BoardGenerated(ByVal TheBoard(,) As Integer) #Region " Constructors " Friend Sub New() Me.GenerateBoard() End Sub #End Region #Region " GenerateBoard " Friend Sub GenerateBoard() Me.bw.RunWorkerAsync() End Sub Private Sub bw_DoWork(ByVal sender As Object, ByVal e As System.ComponentModel.DoWorkEventArgs) Handles bw.DoWork Dim ValidBoard As Boolean = False While ValidBoard = False ValidBoard = GenerateTheBoard() End While End Sub Private Sub bw_RunWorkerCompleted(ByVal sender As Object, ByVal e As System.ComponentModel.RunWorkerCompletedEventArgs) Handles bw.RunWorkerCompleted Dim Copy(8, 8) As Integer For x As Integer = 0I To 8I For y As Integer = 0I To 8I Copy(x, y) = m_TheBoard(x, y) Next y Next x RaiseEvent BoardGenerated(Copy) End Sub #End Region #Region " GenerateTheBoard " Private Function GenerateTheBoard() As Boolean 'Code from JohnH Call ResetBoard() 'try fill a board Dim fillcount As Integer = 0 Do Until fillcount = 81 'find cell with least available options Dim lowestAvailable As Integer = 10 Dim cellref As Point = Point.Empty For x As Integer = 0 To 8 For y As Integer = 0 To 8 If m_TheBoard(x, y) = 0 Then 'only include empty cells in search Dim availCount As Integer = m_Numbers(x, y).Count If availCount = 0 Then Return False 'hit a dead end ElseIf availCount < lowestAvailable Then lowestAvailable = availCount cellref = New Point(x, y) End If End If Next y Next x 'fill that cell Dim available As List(Of Integer) = m_Numbers(cellref.X, cellref.Y) If available.Count = 1 Then m_TheBoard(cellref.X, cellref.Y) = available(0) Else m_TheBoard(cellref.X, cellref.Y) = available(Rand.Next(0, available.Count)) End If RemoveAvailable(cellref.X, cellref.Y) fillcount += 1 Loop Return True 'valid solution End Function #End Region #Region " Friend Methods " Friend Sub ClearBoard() For x As Integer = 0I To 8I For y As Integer = 0I To 8I m_TheBoard(x, y) = 0I Next y Next x End Sub #End Region #Region " ResetBoard " Private Sub ResetBoard() 'Code from JohnH For x As Integer = 0 To 8 For y As Integer = 0 To 8 m_Numbers(x, y) = New List(Of Integer) m_Numbers(x, y).AddRange(New Integer() {1, 2, 3, 4, 5, 6, 7, 8, 9}) m_TheBoard(x, y) = 0 Next y Next x End Sub #End Region #Region " RemoveAvailable " Private Sub RemoveAvailable(ByVal x As Integer, ByVal y As Integer) 'Code from JohnH Dim value As Integer = m_TheBoard(x, y) 'remove from column and row For xx As Integer = 0 To 8 m_Numbers(xx, y).Remove(value) Next xx For yy As Integer = 0 To 8 m_Numbers(x, yy).Remove(value) Next yy 'remove from one of the 3x3 sections Dim xxx As Integer = (x \ 3) * 3 Dim yyy As Integer = (y \ 3) * 3 For xx As Integer = xxx To xxx + 2 For yy As Integer = yyy To yyy + 2 m_Numbers(xx, yy).Remove(value) Next yy Next xx End Sub #End Region End Class
Code:Private WithEvents m_Sudoku As SudokuBoard Private m_ActualBoard(8, 8) As Integer Private Sub GenerateBoard() m_Sudoku = New SudokuBoard End Sub Private Sub m_Sudoku_BoardGenerated(ByVal TheBoard(,) As Integer) Handles m_Sudoku.BoardGenerated For X As Integer = 0 To 8 For Y As Integer = 0 To 8 m_ActualBoard(X, Y) = TheBoard(X, Y) Next Y Next X End Sub


Reply With Quote