mdlCalculation.vb

 ' for calculations

Module mdlCalculation

    Public WithEvents Check As AgentObjects.Agent
    Public MainForm As Form
    Public splash As frmSplash
   
    Private Sub Check_Click(ByVal CharacterID As String, ByVal Button As Short, ByVal Shift As Short, ByVal x As Short, ByVal y As Short) Handles Check.Click
        Check.Characters("check").StopAll()
    End Sub

    Public Sub ErrMsg(ByVal source As String)
        If source = "Agent.Control.2" Then
            MessageBox.Show("The agent is not responding. This can be caused by:" & vbCrLf & vbCrLf & "1) The agent server is not installed properly" & vbCrLf & "2) External service usage" & vbCrLf & vbCrLf & "Close any other program that may have conflicts with agent server or reinstall 8Queens respectively.", "Error", MessageBoxButtons.OK, MessageBoxIcon.Error)
            Application.Exit()
        Else
            MessageBox.Show(Err.Description, "Error", MessageBoxButtons.OK, MessageBoxIcon.Error)
            Application.Exit()
        End If
    End Sub
#Region "Game"
    ' Game members
    Public MarkedQueensArr(,) As Integer = New Integer(5, 2) {}
    Public a1(,) As Integer = New Integer(7, 7) {} 'board(infected zone)
    Public b1(,) As Integer = New Integer(7, 7) {} 'queens
    Public cntr1, cntr2 As Integer
    Public Overloads Function setQueens(ByVal H1 As Integer, ByVal H2 As Integer)
        Dim i, j As Integer
        If a1(H1, H2) <> 1 Then     ' H1 & H2 are selected regions
            a1(H1, H2) = 1
            b1(H1, H2) = 1

            ' close infected regions
            For i = 0 To 7
                a1(i, H2) = 1
            Next i

            For i = 0 To 7
                a1(H1, i) = 1
            Next i

            j = H2
            For i = H1 To 0 Step -1
                If j = 8 Then Exit For
                a1(i, j) = 1
                j += 1
            Next i

            i = H1
            For j = H2 To 0 Step -1
                If i = 8 Then Exit For
                a1(i, j) = 1
                i += 1
            Next j

            j = H2
            For i = H1 To 0 Step -1
                If j = -1 Then Exit For
                a1(i, j) = 1
                j -= 1
            Next i

            j = H2
            For i = H1 To 7
                If j = 8 Then Exit For
                a1(i, j) = 1
                j += 1
            Next i
            cntr2 += 1

        Else
            Return 0 ' reposition
        End If

        For i = 0 To 7
            For j = 0 To 7
                If a1(i, j) > 0 Then cntr1 += 1
            Next j
        Next i

        If cntr1 = 64 Then
            If cntr2 = 8 Then
                reset()
                Return 1 ' success!
            End If
            a1 = New Integer(7, 7) {}
            b1 = New Integer(7, 7) {}
            cntr2 = 0
            cntr1 = 0
            Return 2 ' resetBoard
        Else
            cntr1 = 0
            Return 3 ' continue
        End If
    End Function
    Public Sub reset()             ' prepare the new board, is
        a1 = New Integer(7, 7) {}  ' also called by frmChessGame
        b1 = New Integer(7, 7) {}
        cntr1 = 0
        cntr2 = 0
    End Sub
    Public Sub setMarkedQueens(ByVal H1 As Integer, ByVal H2 As Integer)
        Dim i, j As Integer
        For i = 0 To 7
            If a1(i, H2) = 1 And b1(i, H2) = 1 Then
                MarkedQueensArr(0, 0) = i
                MarkedQueensArr(0, 1) = H2
                MarkedQueensArr(0, 2) = 1
                Exit For
            End If
        Next i

        For i = 0 To 7
            If a1(H1, i) = 1 And b1(H1, i) = 1 Then
                MarkedQueensArr(1, 0) = H1
                MarkedQueensArr(1, 1) = i
                MarkedQueensArr(1, 2) = 1
                Exit For
            End If
        Next i

        j = H2
        For i = H1 To 0 Step -1
            If j = 8 Then Exit For
            If a1(i, j) = 1 And b1(i, j) = 1 Then
                MarkedQueensArr(2, 0) = i
                MarkedQueensArr(2, 1) = j
                MarkedQueensArr(2, 2) = 1
                Exit For
            End If
            j += 1
        Next i

        i = H1
        For j = H2 To 0 Step -1
            If i = 8 Then Exit For
            If a1(i, j) = 1 And b1(i, j) = 1 Then
                MarkedQueensArr(3, 0) = i
                MarkedQueensArr(3, 1) = j
                MarkedQueensArr(3, 2) = 1
                Exit For
            End If
            i += 1
        Next j

        j = H2
        For i = H1 To 0 Step -1
            If j = -1 Then Exit For
            If a1(i, j) = 1 And b1(i, j) = 1 Then
                MarkedQueensArr(4, 0) = i
                MarkedQueensArr(4, 1) = j
                MarkedQueensArr(4, 2) = 1
                Exit For
            End If
            j -= 1
        Next i

        j = H2
        For i = H1 To 7
            If j = 8 Then Exit For
            If a1(i, j) = 1 And b1(i, j) = 1 Then
                MarkedQueensArr(5, 0) = i
                MarkedQueensArr(5, 1) = j
                MarkedQueensArr(5, 2) = 1
                Exit For
            End If
            j += 1
        Next i

    End Sub     ' Game members
#End Region
#Region "Help"
    ' Help members
    Public HelpIsOn As Boolean = False
    Public index As Integer
    Public a2(,), b2(,) As Integer
    Public Pssblts As New ArrayList
    Public Overloads Sub setQueens()
        Dim RndObj As New Random
        Dim H1, H2 As Integer
        Static cntr1, cntr2 As Integer
        Dim i, j As Integer

        If Pssblts.Count = 0 Or HelpIsOn Then

            a2 = New Integer(7, 7) {}
            b2 = New Integer(7, 7) {}
Place:
            H1 = RndObj.Next(0, 8)
            H2 = RndObj.Next(0, 8)
            If a2(H1, H2) <> 1 Then
                a2(H1, H2) = 1
                b2(H1, H2) = 1

                For i = 0 To 7
                    a2(i, H2) = 1
                Next i

                For i = 0 To 7
                    a2(H1, i) = 1
                Next i

                j = H2
                For i = H1 To 0 Step -1
                    If j = 8 Then Exit For
                    a2(i, j) = 1
                    j += 1
                Next i

                i = H1
                For j = H2 To 0 Step -1
                    If i = 8 Then Exit For
                    a2(i, j) = 1
                    i += 1
                Next j

                j = H2
                For i = H1 To 0 Step -1
                    If j = -1 Then Exit For
                    a2(i, j) = 1
                    j -= 1
                Next i

                j = H2
                For i = H1 To 7
                    If j = 8 Then Exit For
                    a2(i, j) = 1
                    j += 1
                Next i
                cntr2 += 1
            Else
                GoTo Place
            End If

            For i = 0 To 7
                For j = 0 To 7
                    If a2(i, j) = 1 Then cntr1 += 1
                Next j
            Next i

            If cntr1 = 64 Then
                If cntr2 = 8 Then

                    If (Pssblts.Count <> 0) Then
                        For i = 0 To Pssblts.Count / 8 - 1
                            'Console.WriteLine("&&&&&&&&&&&&&&& " & Pssblts.Count)
                            Dim flag As Integer = 0
                            For j = 0 To 7
                                Dim h, k As Integer
                                h = Mid(Pssblts(i * 8 + j), 1, 1)
                                k = Mid(Pssblts(i * 8 + j), 3, 1)
                                'Console.WriteLine(h & " " & k & " " & b2(h, k))
                                If b2(h, k) = 1 Then
                                    flag += 1
                                End If
                            Next

                            If flag = 8 Then
                                'Console.WriteLine("^^^^^^^^^^^^^^ " & Pssblts.Count / 8)
                                a2 = New Integer(7, 7) {}
                                b2 = New Integer(7, 7) {}
                                cntr2 = 0
                                cntr1 = 0
                                GoTo place
                            End If
                        Next
                    End If

                    For i = 0 To 7
                        For j = 0 To 7
                            If b2(i, j) = 1 Then
                                Pssblts.Add(i & " " & j)
                            End If
                        Next
                    Next

                    Exit Sub
                End If
                a2 = New Integer(7, 7) {}
                b2 = New Integer(7, 7) {}
                cntr2 = 0
                cntr1 = 0
                GoTo place
            Else
                cntr1 = 0
                GoTo place
            End If
        Else
            b2 = New Integer(7, 7) {}
            For i = 0 To 7
                Dim h, k As Integer
                h = Mid(Pssblts(i), 1, 1)
                k = Mid(Pssblts(i), 3, 1)
                b2(h, k) = 1
            Next
        End If
    End Sub
#End Region
End Module

Project Homepage: