The latest version of the core collaboration project is included here. If you do changes to the project and you wish to see them in the "official" version, you may attach it in your post here or send it via private message to me.
Remember that you are free to improve any part of the project. There are three main parts where you can put your interest into:
The core project: interface, file loading/saving, manual solving, etc.
Solver modules.
Generator modules.
It is up to you how you do your solver or generator module or how you construct your functions.
Including a solver module
You must provide a wrapper code that is used to make your code work with the core project. This is a function that is to be added into clsCodeWrapper. Add this into your post when you post your source code (prefer using the code tag over highlight tag).
Also check Form_Load on how to make the core project to know about your function.
Including a generator module
Currently there is no way to add a generator module into the project. This is because I believe there is a need for giving input parameters for generators, thus there is a need for more definition on how they should work. My initial thoughts are that they would be class modules that have certain features to make it possible for the core to know what the generator class supports.
Public Function DairyLogic(ByRef SudokuBoard As String) As String
Dim lngOut() As Long
lngOut = SudokuStringToLongArray(SudokuBoard)
MilkSolve lngOut
DairyLogic = SudokuLongArrayToString(lngOut)
End Function
Helper Routines: Updated 17/7/7
Two possible routines for ModHelpers, a board dump showing possible solutions (designed for Tahoma bold), and a simple sub to invert bits of a long array (so it could store possible or impossible). I'm using the board dump on a blank form I've inserted into the project to help me decide how to code the next logical step. Feel free not to use them if you don't think they a relevant, feel free to rewrite them if you don't like the code.
Public Sub DumpBoard(TgtObject As Object, _
SudokuBoard() As Long, _
Optional ByVal BoardSize As Long = -1, _
Optional ByVal XOffset As Long = 0, _
Optional ByVal YOffset As Long = 0)
'draws a board showing possible solutions
Dim i As Long, ii As Long, UnitSize As Long, YAdjust As Long, XAdjust As Long
With TgtObject
If BoardSize < 1 Then
If .ScaleWidth + XOffset > .ScaleHeight + YOffset Then
BoardSize = .ScaleHeight - YOffset
Else
BoardSize = .ScaleWidth - XOffset
End If
End If
UnitSize = BoardSize \ 9
YAdjust = UnitSize \ 30
XAdjust = UnitSize \ 30
TgtObject.Cls
'draw grid
For i = 0 To 9
Select Case i Mod 3
Case 0: .DrawWidth = 2
Case 1: .DrawWidth = 1
End Select
TgtObject.Line (0 + XOffset, i * UnitSize + YOffset)-Step(BoardSize, 0)
TgtObject.Line (i * UnitSize + XOffset, YOffset)-Step(0, BoardSize)
Next i
'draw solved
.FontSize = UnitSize / 24
For i = 0 To 80
If BITCOUNT(SudokuBoard(i)) = 1 Then
.CurrentY = (i \ 9) * UnitSize - YAdjust + YOffset
.CurrentX = (i Mod 9) * UnitSize - XAdjust + XOffset
TgtObject.Print BITNUMBER(SudokuBoard(i))
End If
Next i
'draw possible
.FontSize = UnitSize / 70
For i = 0 To 80
If BITCOUNT(SudokuBoard(i)) <> 1 Then
For ii = 1 To 9
If SudokuBoard(i) And BITTABLE(ii) Then
XAdjust = ((ii - 1) Mod 3) * (UnitSize / 3)
YAdjust = ((ii - 1) \ 3) * (UnitSize / 3)
.CurrentY = (i \ 9) * UnitSize + YAdjust + YOffset
.CurrentX = (i Mod 9) * UnitSize + XAdjust + XOffset
TgtObject.Print ii
End If
Next ii
End If
Next i
End With
End Sub
Public Function InvertSudokuBits(ByRef SudokuBoardBits() As Long) As Long()
'Possible Solutions to Impossible Solutions and visa versa
Dim i As Long, lngOut(80) As Long
For i = 0 To 80
lngOut(i) = SudokuBoardBits(i) Xor BITS9
Next i
InvertSudokuBits = lngOut
End Function
BugFix: 17/7/7
Code:
Public Function SudokuStringToLongArray(ByRef SudokuBoard As String) As Long()
Dim lngA As Long, lngCurrent As Long, lngOut(80) As Long
' validate length
If LenB(SudokuBoard) = 162 Then
For lngA = 0 To 80
' get the number
lngCurrent = AscW(Mid$(SudokuBoard, 1 + lngA, 1)) And Not 48
' see which bits to set active by this number
If lngCurrent > 0 And lngCurrent < 10 Then
' mark only the known bit active
lngOut(lngA) = BITTABLE(lngCurrent)
Else
' mark all bits active
lngOut(lngA) = BITS9
End If
Next lngA
End If
' output
SudokuStringToLongArray = lngOut
End Function
Last edited by Milk; Jul 16th, 2007 at 07:19 PM.
Reason: Solver added
The following 3 subs work together to create a valid sudoku grid.
They work basically the way a designer makes them. place a 1 randomly in one 3x3 square, put one in the next square wherever it is legal to put it, and so on until all ones are done, then move on to 2 and fill all of them in. Expects there to be a global variable SudokuGrid(8,8) as integer
Code:
Private Sub SetupGrid()
Dim cl As Integer, xl As Long
Call EraseSudokuGrid()
For cl = 1 To 9
Do
If GenerateGrid(cl) = True Then Exit Do
xl = xl + 1
If xl = 10 Then 'if you get too many grid failures, start over
Call EraseSudokuGrid()
xl = 0
cl = 0
Exit Do
End If
Loop
Next cl
Me.Invalidate()
End Sub
Private Sub EraseSudokuGrid()
Dim x As Integer, y As Integer
For x = 0 To 8
For y = 0 To 8
SudokuGrid(x, y) = 0
Next
Next
End Sub
Private Function GenerateGrid(ByVal Num As Integer)
Dim ExitCounter As Long
Dim BlockedGrid(8, 8) As Boolean
Dim WorkGrid(8, 8) As Boolean
Dim Rnd_X As Long, Rnd_Y As Long
Dim x As Long, y As Long
Dim BlockedGrid_X As Long ', BlockedGrid_Y As Long
Dim Illegal As Boolean
'plan: Fill in work grid, using blockedgrid to check with.
'then parse and make sure each entry is available in sudokugrid
'if not, start over
For y = 0 To 8 Step 3
For x = 0 To 8 Step 3
Do
ExitCounter = ExitCounter + 1
If ExitCounter = 500 Then GenerateGrid = False : Exit Function ' in case of grid lock up
Illegal = False 'marker
'this loop returns a base value of the upper left corner of each square
'first, generate a x & y location
Rnd_X = Int(Rnd() * 3) + x 'adds 0,1, or 2 to current x
Rnd_Y = Int(Rnd() * 3) + y 'adds 0,1, or 2 to current x
'make sure location isn't taken
Illegal = BlockedGrid(Rnd_X, Rnd_Y)
If Illegal = False Then If SudokuGrid(Rnd_X, Rnd_Y) <> 0 Then Illegal = True
If Illegal = False Then Exit Do
Loop
'got a valid position, now mark it on the BlockedGrid so we
'don't try to put another number in it's row or column
For BlockedGrid_X = 0 To 8
BlockedGrid(BlockedGrid_X, Rnd_Y) = True 'fill in row
BlockedGrid(Rnd_X, BlockedGrid_X) = True 'fill in column
Next BlockedGrid_X
'now store the number on the workgrid
WorkGrid(Rnd_X, Rnd_Y) = Num
Next x
Next y
'finally, parse workgrid onto sudokugrid
For x = 0 To 8
For y = 0 To 8
'final error check
If WorkGrid(x, y) = True Then
If SudokuGrid(x, y) > 0 Then GenerateGrid = False : Exit Function 'final error check
SudokuGrid(x, y) = Num
End If
Next
Next
GenerateGrid = True
End Function
Reply With Quote
