locked
Sudoko Test 3 RRS feed

  • Question

  • From VS 2013 VB.Net form app:

    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.TopLeft : Return {c(0), c(1), c(2), c(9), c(10), c(11), c(18), c(19), c(20)}.ToList
                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.CenterLeft : Return {c(27), c(28), c(29), c(36), c(37), c(38), c(45), c(46), c(47)}.ToList
                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.BottomLeft : Return {c(54), c(55), c(56), c(63), c(64), c(65), c(72), c(73), c(74)}.ToList
                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
    Karl


    When you see answers and helpful posts, please click Vote As Helpful, Propose As Answer, and/or Mark As Answer.
    My Blog: Unlock PowerShell
    My Book: Windows PowerShell 2.0 Bible
    My E-mail: -join ('6F6C646B61726C406F75746C6F6F6B2E636F6D'-split'(?<=\G.{2})'|%{if($_){[char][int]"0x$_"}})

    Friday, November 21, 2014 8:02 PM

All replies

  • Your test looks right.... 

    “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.

    Friday, November 21, 2014 8:09 PM