Sudoku test 26

Question

Came up with this sudoku game, thought I would share :-) Enjoy
Form1's code:
Option Strict On
Option Explicit On
Option Infer Off
Public Class Form1
Private gameNumbers As New List(Of Integer) From {5, 3, 0, 0, 7, 0, 0, 0, 0, 6, 0, 0, 1, 9, 5, 0, 0, 0, 0, 9, _
8, 0, 0, 0, 0, 6, 0, 8, 0, 0, 0, 6, 0, 0, 0, 3, 4, 0, 0, 8, _
0, 3, 0, 0, 1, 7, 0, 0, 0, 2, 0, 0, 0, 6, 0, 6, 0, 0, 0, 0, _
2, 8, 0, 0, 0, 0, 4, 1, 9, 0, 0, 5, 0, 0, 0, 0, 8, 0, 0, 7, 9}
Private sGame As New SudokuGame(Me, gameNumbers)
Private Sub Form1_SizeChanged(sender As Object, e As EventArgs) Handles Me.SizeChanged
Me.Invalidate()
End Sub
Private Sub Form1_Load(sender As Object, e As EventArgs) Handles MyBase.Load
Me.DoubleBuffered = True
End Sub
End Class
Sudoku game class
Public Class SudokuGame
Public Property cellHeight As Integer = 20
Public Property cellWidth As Integer = 20
Public Property canvas As Control
Private center As New Point(200, 200)
Private mouseisDown As Boolean = False
Private numbers As New List(Of SudokuGame.NumberCell)
Private numberCells As New List(Of SudokuGame.NumberCell)
Private currentPT As Point = New Point(0, 0)
Private dFont As New Font("segoe script", 12)
Private mousex As Integer
Private mousey As Integer
Friend WithEvents EditTB As New RichTextBox With {.Parent = canvas, .BorderStyle = BorderStyle.None, .Visible = False, .Font = New Font("Consolas", 16), .MaxLength = 1, .Multiline = False, .ForeColor = Color.Red, .BackColor = Color.DarkGoldenrod}
Private editingIndex As Integer = 0
Public Function CanCommitChange(ByRef numbercells As List(Of NumberCell), ByRef numberCell As NumberCell) As Boolean
Dim cellRegionEnum As SudokuRegion = GetCellRegionEnum(numberCell)
Dim cellRegion As List(Of NumberCell) = Me.GetRegion(numbercells, cellRegionEnum)
Dim cellColumn As List(Of NumberCell) = Me.GetColumn(numbercells, numberCell.X)
Dim cellRow As List(Of NumberCell) = Me.GetRow(numbercells, numberCell.Y)
For Each nC As NumberCell In cellRegion
If nC.Value = numberCell.Value Then
If numberCell.Value = 0 Then Continue For
Return False
End If
Next
For Each nC As NumberCell In cellColumn
If nC.Value = numberCell.Value Then
If numberCell.Value = 0 Then Continue For
Return False
End If
Next
For Each nC As NumberCell In cellRow
If nC.Value = numberCell.Value Then
If numberCell.Value = 0 Then Continue For
Return False
End If
Next
Return True
End Function
Function colString(col As List(Of NumberCell)) As String
Dim s As String = String.Empty
For Each n As NumberCell In col
s = s & n.Value
Next
Return s
End Function
Public Function GetCellRegionEnum(numberCell As NumberCell) As SudokuRegion
Dim result As String = String.Empty
Dim tLregion As New List(Of Integer) From {0, 1, 2, 9, 10, 11, 18, 19, 20}
Dim tCregion As New List(Of Integer) From {3, 4, 5, 12, 13, 14, 21, 22, 23}
Dim tRregion As New List(Of Integer) From {6, 7, 8, 15, 16, 17, 24, 25, 26}
Dim cLregion As New List(Of Integer) From {27, 28, 29, 36, 37, 38, 45, 46, 47}
Dim cCregion As New List(Of Integer) From {30, 31, 32, 39, 40, 41, 48, 49, 50}
Dim cRregion As New List(Of Integer) From {33, 34, 35, 42, 43, 44, 51, 52, 53}
Dim bLregion As New List(Of Integer) From {54, 55, 56, 63, 64, 65, 72, 73, 74}
Dim bCregion As New List(Of Integer) From {57, 58, 59, 66, 67, 68, 75, 76, 77}
Dim bRregion As New List(Of Integer) From {60, 61, 62, 69, 70, 71, 78, 79, 80}
Select Case True
Case tLregion.IndexOf(numberCell.ArrayIndex) > -1 : Return SudokuRegion.TopLeft
Case tCregion.IndexOf(numberCell.ArrayIndex) > -1 : Return SudokuRegion.TopCenter
Case tRregion.IndexOf(numberCell.ArrayIndex) > -1 : Return SudokuRegion.TopRight
Case cLregion.IndexOf(numberCell.ArrayIndex) > -1 : Return SudokuRegion.CenterLeft
Case cCregion.IndexOf(numberCell.ArrayIndex) > -1 : Return SudokuRegion.CenterCenter
Case cRregion.IndexOf(numberCell.ArrayIndex) > -1 : Return SudokuRegion.CenterRight
Case bLregion.IndexOf(numberCell.ArrayIndex) > -1 : Return SudokuRegion.BottomLeft
Case bCregion.IndexOf(numberCell.ArrayIndex) > -1 : Return SudokuRegion.BottomCenter
Case bRregion.IndexOf(numberCell.ArrayIndex) > -1 : Return SudokuRegion.BottomRight
End Select
Return Nothing
End Function
Public Function GetColumn(numbercells As List(Of NumberCell), colNumber As Integer) As List(Of NumberCell)
Dim results As New List(Of NumberCell)
For i As Integer = colNumber To 80 Step 9
results.Add(numbercells(i))
Next
Return results
End Function
Public Function GetRow(numbercells As List(Of NumberCell), rowNumber As Integer) As List(Of NumberCell)
Dim start As Integer = rowNumber * 9
Dim results As New List(Of NumberCell)
For I As Integer = start To start + 8
results.Add(numbercells(I))
Next
Return results
End Function
Public Function RegionToString(numbercells As List(Of NumberCell), sRegion As SudokuRegion) As String
Dim region As List(Of NumberCell) = Me.GetRegion(numbercells, sRegion)
Dim sb As New System.Text.StringBuilder
For i As Integer = 1 To region.Count
sb.Append(region(i - 1).Value.ToString)
If i Mod 3 = 0 Then sb.Append(vbCrLf)
Next
Return sb.ToString
End Function
Private Function ZeroCount(s As String) As Integer
Dim result As Integer
For Each c As Char In s
If c = "0"c Then result += 1
Next
Return result
End Function
Public Function GetRegion(numbercells As List(Of NumberCell), region As SudokuRegion) As List(Of NumberCell)
Dim c As List(Of NumberCell) = numbercells
Select Case region
Case SudokuRegion.Top
Case SudokuRegion.TopCenter : Return {c(3), c(4), c(5), c(12), c(13), c(14), c(21), c(22), c(23)}.ToList
Case SudokuRegion.TopRight : Return {c(6), c(7), c(8), c(15), c(16), c(17), c(24), c(25), c(26)}.ToList
Case SudokuRegion.Center
Case SudokuRegion.CenterCenter : Return {c(30), c(31), c(32), c(39), c(40), c(41), c(48), c(49), c(50)}.ToList
Case SudokuRegion.CenterRight : Return {c(33), c(34), c(35), c(42), c(43), c(44), c(51), c(52), c(53)}.ToList
Case SudokuRegion.Bottom
Case SudokuRegion.BottomCenter : Return {c(57), c(58), c(59), c(66), c(67), c(68), c(75), c(76), c(77)}.ToList
Case SudokuRegion.BottomRight : Return {c(60), c(61), c(62), c(69), c(70), c(71), c(78), c(79), c(80)}.ToList
End Select
Return New List(Of NumberCell)
End Function
Public Enum SudokuRegion
TopLeft
TopCenter
TopRight
CenterLeft
CenterCenter
CenterRight
BottomLeft
BottomCenter
BottomRight
End Enum
Public Function renderSudakoCard(g As Graphics, center As Point, frameSize As Size, backColor As Color, numbers As List(Of NumberCell), font As Font) As List(Of NumberCell)
Dim results As New List(Of NumberCell)
Dim boldEveryNLines As Integer = 3
Dim BoldLines As Boolean = True
Dim rowCount As Integer = 9
Dim columnCount As Integer = 9
g.Clear(backColor)
Dim combo As String = "000000"
If rowCount Mod 2 = 1 Then combo = combo & "1" Else combo = combo & "0"
If columnCount Mod 2 = 1 Then combo = combo & "1" Else combo = combo & "0"
If cellHeight Mod 2 = 1 Then cellHeight += 1
If cellWidth Mod 2 = 1 Then cellWidth += 1
Select Case Convert.ToInt32(combo, 2)
Case 0
Dim centerX As Integer = center.X
Dim centerY As Integer = center.Y
Dim topY As Integer = centerY - ((rowCount \ 2) * cellHeight)
Dim bottomY As Integer = centerY + ((rowCount \ 2) * cellHeight)
Dim leftX As Integer = centerX - ((columnCount \ 2) * cellWidth)
Dim rightX As Integer = centerX + ((columnCount \ 2) * cellWidth)
RenderBackGround(g, topY, bottomY, leftX, rightX)
DrawLines(g, leftX, rightX, topY, bottomY, boldEveryNLines, BoldLines)
results.AddRange(DrawNumbers(g, numbers, topY, leftX, font))
Case 1
Dim centerX As Integer = center.X
Dim centerY As Integer = center.Y
Dim topY As Integer = centerY - ((rowCount \ 2) * cellHeight)
Dim bottomY As Integer = centerY + ((rowCount \ 2) * cellHeight)
Dim remainderColumns As Integer = (columnCount - 1) \ 2
Dim leftX As Integer = (centerX - (cellWidth \ 2)) - (remainderColumns * cellWidth)
Dim rightX As Integer = (centerX + (cellWidth \ 2)) + (remainderColumns * cellWidth)
RenderBackGround(g, topY, bottomY, leftX, rightX)
DrawLines(g, leftX, rightX, topY, bottomY, boldEveryNLines, BoldLines)
results.AddRange(DrawNumbers(g, numbers, topY, leftX, font))
Case 2
Dim centerX As Integer = center.X
Dim centerY As Integer = center.Y
Dim remainderRows As Integer = (rowCount - 1) \ 2
Dim topY As Integer = (centerY - (cellHeight \ 2)) - (remainderRows * cellHeight)
Dim bottomY As Integer = (centerY + (cellHeight \ 2)) + (remainderRows * cellHeight)
Dim leftX As Integer = centerX - ((columnCount \ 2) * cellWidth)
Dim rightX As Integer = centerX + ((columnCount \ 2) * cellWidth)
RenderBackGround(g, topY, bottomY, leftX, rightX)
DrawLines(g, leftX, rightX, topY, bottomY, boldEveryNLines, BoldLines)
results.AddRange(DrawNumbers(g, numbers, topY, leftX, font))
Case 3
Dim centerX As Integer = center.X
Dim centerY As Integer = center.Y
Dim remainderRows As Integer = (rowCount - 1) \ 2
Dim topY As Integer = (centerY - (cellHeight \ 2)) - (remainderRows * cellHeight)
Dim bottomY As Integer = (centerY + (cellHeight \ 2)) + (remainderRows * cellHeight)
Dim remainderColumns As Integer = (columnCount - 1) \ 2
Dim leftX As Integer = (centerX - (cellWidth \ 2)) - (remainderColumns * cellWidth)
Dim rightX As Integer = (centerX + (cellWidth \ 2)) + (remainderColumns * cellWidth)
RenderBackGround(g, topY, bottomY, leftX, rightX)
DrawLines(g, leftX, rightX, topY, bottomY, boldEveryNLines, BoldLines)
results.AddRange(DrawNumbers(g, numbers, topY, leftX, font))
End Select
Return results
End Function
Private Sub RenderBackGround(g As Graphics, topY As Integer, bottomY As Integer, LeftX As Integer, RightX As Integer)
Dim left As Integer = LeftX - 5
Dim top As Integer = topY - 5
Dim width As Integer = (RightX - left) + 5
Dim height As Integer = (bottomY - top) + 5
Dim backGround As New Rectangle(left, top, width, height)
g.FillRectangle(Brushes.White, backGround)
End Sub
Public Function GetCellAt(arr As List(Of NumberCell), location As Point) As NumberCell
Dim index As Integer = (location.Y * 9) + location.X
Return arr(index)
End Function
Private Sub DrawLines(g As Graphics, leftX As Integer, rightX As Integer, topY As Integer, bottomY As Integer, boldEveryNLines As Integer, boldLines As Boolean)
Dim cnt As Integer = 0
Dim sudPen As New Pen(Brushes.OliveDrab, 2)
For x As Integer = leftX To rightX Step cellWidth
Dim p1 As New Point(x, topY)
Dim p2 As New Point(x, bottomY)
If cnt Mod boldEveryNLines = 0 AndAlso boldLines = True Then
g.DrawLine(sudPen, p1, p2)
Else
g.DrawLine(Pens.Black, p1, p2)
End If
cnt += 1
Next
cnt = 0
For y As Integer = topY To bottomY Step cellHeight
Dim p1 As New Point(leftX, y)
Dim p2 As New Point(rightX, y)
If cnt Mod boldEveryNLines = 0 AndAlso boldLines = True Then
g.DrawLine(sudPen, p1, p2)
Else
g.DrawLine(Pens.Black, p1, p2)
End If
cnt += 1
Next
End Sub
Private Function DrawNumbers(g As Graphics, numbers As List(Of NumberCell), topY As Integer, leftX As Integer, font As Font) As List(Of NumberCell)
Dim results As New List(Of NumberCell)
Dim counter As Integer = 1
Dim txtY As Integer = topY + (cellHeight \ 2)
Dim locX As Integer = 0
Dim locY As Integer = 0
For I As Integer = 0 To numbers.Count - 1
Dim n As Integer = numbers(I).Value
Dim x As Integer = (leftX - (cellWidth \ 2)) + (cellWidth * counter)
Dim nString As String = n.ToString
Dim textSizeF As SizeF = g.MeasureString(nString, font)
Dim textSize As Size = New Size(CInt(textSizeF.Width), CInt(textSizeF.Height))
Dim nX As Integer = x - (textSize.Width \ 2)
Dim nY As Integer = txtY - (textSize.Height \ 2)
Dim cX As Integer = leftX + (cellWidth * counter) - cellWidth
Dim cy As Integer = txtY - (cellHeight \ 2)
Dim cR As New Rectangle(cX, cy, cellWidth, cellHeight)
Dim nCell As New NumberCell(n, I)
nCell.Locked = numbers(I).Locked
nCell.Bounds = cR
nCell.X = locX
nCell.Y = locY
results.Add(nCell)
locX += 1
counter += 1
If counter Mod 10 = 0 Then
txtY += cellHeight
locY += 1
locX = 0
counter = 1
End If
If n = Nothing OrElse n = 0 Then Continue For
If nCell.Locked = True Then
g.DrawString(nString, font, Brushes.Black, New Point(nX, nY))
Else
g.DrawString(nString, New Font(font.FontFamily, font.Size, FontStyle.Bold), Brushes.Green, New Point(nX, nY))
End If
Next
Return results
End Function
Public Class NumberCell
Public Property Bounds As New Rectangle
Public Property ArrayIndex As Integer
Public Property Value As Integer
Public Property Locked As Boolean = False
Public Property X As Integer
Public Property Y As Integer
Sub New(value As Integer, ArrayIndex As Integer)
Me.Value = value
Me.ArrayIndex = ArrayIndex
If value = 0 Then
Me.Locked = False
Else
Me.Locked = True
End If
End Sub
Public Function IntersectsWith(pt As Point) As Boolean
Return Bounds.IntersectsWith(New Rectangle(pt, New Size(1, 1)))
End Function
Public Shadows Function ToString() As String
Return String.Format("Value={0} ArrayIndex={1} {2} X={3} Y={4}", Me.Value, Me.ArrayIndex, Me.Bounds.ToString, Me.X, Me.Y)
End Function
End Class
Sub AddHandlers()
AddHandler canvas.MouseClick, AddressOf canvas_MouseClick
AddHandler canvas.Paint, AddressOf canvas_Paint
AddHandler canvas.MouseMove, AddressOf canvas_MouseMove
AddHandler canvas.MouseUp, AddressOf canvas_MouseUp
AddHandler canvas.MouseDown, AddressOf canvas_MouseDown
End Sub
Private Sub canvas_MouseClick(sender As Object, e As MouseEventArgs)
If e.Button = Windows.Forms.MouseButtons.Right Then Exit Sub
For Each n As SudokuGame.NumberCell In numberCells
If n.IntersectsWith(currentPT) Then
If Not n.Locked Then
If n.Value > 0 Then
EditTB.Text = n.Value.ToString
Else
EditTB.Text = ""
End If
EditTB.Visible = True
EditTB.Width = n.Bounds.Width - 1
EditTB.Height = n.Bounds.Height - 1
EditTB.Left = n.Bounds.X + 1
EditTB.Top = n.Bounds.Y + 1
EditTB.Focus()
EditTB.SelectionStart = 0
EditTB.SelectionLength = EditTB.Text.Length
editingIndex = n.ArrayIndex
Else
EditTB.Visible = False
End If
canvas.Invalidate()
Exit For
Else
End If
Next
End Sub
Private Sub canvas_Paint(sender As Object, e As PaintEventArgs)
canvas.Text = "Sudoku v0.1 by Paul Ishak"
numberCells = Me.renderSudakoCard(e.Graphics, center, canvas.ClientRectangle.Size, canvas.BackColor, numbers, dFont)
e.Graphics.DrawString("Use the RIGHT mouse button to drag the sudoku grid.", New Font("segoe script", 12), Brushes.Black, New Point(5, 5))
End Sub
Sub CommitChange()
If Not EditTB.Text = "" Then
Try
Dim tmp As SudokuGame.NumberCell = numberCells(editingIndex)
Dim intValue As Integer = 0
Integer.TryParse(EditTB.Text, intValue)
If intValue > 9 Then intValue = 9
Dim newCell As New SudokuGame.NumberCell(intValue, tmp.ArrayIndex)
newCell.Bounds = tmp.Bounds
newCell.Locked = tmp.Locked
newCell.X = tmp.X
newCell.Y = tmp.Y
If Me.CanCommitChange(numberCells, newCell) Then
numbers(editingIndex) = newCell
numberCells(editingIndex) = newCell
EditTB.Text = ""
EditTB.Visible = False
canvas.Invalidate()
Else
EditTB.Text = ""
EditTB.Visible = False
Beep()
canvas.Invalidate()
End If
Catch ex As Exception
MsgBox(ex.Message)
End Try
End If
End Sub
Public Function configureGame(gameNumbers As List(Of Integer)) As List(Of SudokuGame.NumberCell)
Dim result As New List(Of SudokuGame.NumberCell)
For I As Integer = 1 To 81
result.Add(New SudokuGame.NumberCell(gameNumbers(I - 1), I - 1))
Next
Return result
End Function
Private Sub canvas_MouseMove(sender As Object, e As MouseEventArgs)
Dim pt As Point = canvas.PointToClient(Control.MousePosition)
currentPT = pt
If mouseisDown Then
center = pt
canvas.Invalidate()
Else
End If
End Sub
Private Sub canvas_MouseUp(sender As Object, e As MouseEventArgs)
mouseisDown = False
End Sub
Private Sub canvas_MouseDown(sender As Object, e As MouseEventArgs)
If e.Button = Windows.Forms.MouseButtons.Right Then
EditTB.Visible = False
mouseisDown = True
ElseIf e.Button = Windows.Forms.MouseButtons.Left Then
End If
End Sub
Private Sub EditTB_KeyDown(sender As Object, e As KeyEventArgs) Handles EditTB.KeyDown
Select Case True
Case e.KeyCode = Keys.Enter
End Select
End Sub
Private Sub EditTB_KeyUp(sender As Object, e As KeyEventArgs) Handles EditTB.KeyUp
CommitChange()
End Sub
Sub New(canvas As Control, gameNumbers As List(Of Integer))
Me.canvas = canvas
EditTB.Parent = canvas
AddHandlers()
numbers = configureGame(gameNumbers)
End Sub
End Class
“If you want something you've never had, you need to do something you've never done.”
Don't forget to mark
helpful posts and answers
! Answer an interesting question? Write a
new article
about it! My Articles
*This post does not reflect the opinion of Microsoft, or its employees.

Answer 1

Have you tried searching for the error message? A few min on google gives some useful advice.
http://stackoverflow.com/questions/14527201/vhdl-assigning-default-values
"All entity inputs must have either a signal driving them, or a default value specified in the entity declaration."