Студопедия

Главная страница Случайная страница

КАТЕГОРИИ:

АвтомобилиАстрономияБиологияГеографияДом и садДругие языкиДругоеИнформатикаИсторияКультураЛитератураЛогикаМатематикаМедицинаМеталлургияМеханикаОбразованиеОхрана трудаПедагогикаПолитикаПравоПсихологияРелигияРиторикаСоциологияСпортСтроительствоТехнологияТуризмФизикаФилософияФинансыХимияЧерчениеЭкологияЭкономикаЭлектроника






FrmGame






Public Class frmGame

 

Class counter

Public colour As Char

Public x As Integer

Public y As Integer

Public king As Boolean

Public selected As Boolean

Public live As Boolean

 

Public Sub New(nx, ny, ncolour)

x = nx

y = ny

colour = ncolour

king = False

live = True

End Sub

 

Private Sub kinged()

king = True

End Sub

 

Public Sub die()

live = False

End Sub

 

Public Sub click()

selected = Not (selected)

End Sub

 

Public Sub move(nx, ny)

x = nx

y = ny

 

If colour = " W" And y = 0 Then

kinged()

End If

 

If colour = " B" And y = 7 Then

kinged()

End If

 

End Sub

 

End Class

 

Class AI

 

Public colour As Char

Public pieces(23) As Boolean

 

Public Sub findMoves()

If colour = " B" Then

For n = 0 To 11

pieces(n) = False

 

If frmGame.movePossible(frmGame.counters(n)) Then

pieces(n) = True

End If

Next

Else

For n = 12 To 13

pieces(n) = False

 

If frmGame.movePossible(frmGame.counters(n)) Then

pieces(n) = True

End If

Next

End If

End Sub

 

Public Sub makeMove()

Dim temp As Integer

 

Do

temp = GetRandom(0, 23)

Loop While pieces(temp) = False

 

If colour = " B" Then

AImoveBlack(temp)

Else

AImoveWhite(temp)

End If

 

End Sub

 

Public Sub AImoveBlack(id)

Dim tempx, tempy, tox, toy, king As Integer

tempx = frmGame.counters(id).x

tempy = frmGame.counters(id).y

 

'give full range of moves if king

If frmGame.counters(id).king = True Then

king = 3

Else

king = 1

End If

 

 

If frmGame.jumpPossible(frmGame.counters(id)) Then

Do

Select Case GetRandom(0, king)

Case 0

tox = tempx + 2

toy = tempy + 2

Case 1

tox = tempx - 2

toy = tempy + 2

Case 2

tox = tempx + 2

toy = tempy - 2

Case 3

tox = tempx - 2

toy = tempy - 2

End Select

 

Loop While frmGame.validMove(frmGame.counters(id), tox, toy) = False

Else

'single move

Do

'give a random space for the piece to move

Select Case GetRandom(0, king)

Case 0

tox = tempx + 1

toy = tempy + 1

Case 1

tox = tempx - 1

toy = tempy + 1

Case 2

tox = tempx + 1

toy = tempy - 1

Case 3

tox = tempx - 1

toy = tempy - 1

End Select

 

Loop While frmGame.validMove(frmGame.counters(id), tox, toy) = False

End If

 

'move the piece to the safe location

frmGame.movePiece(tox, toy)

End Sub

 

Public Sub AImoveWhite(id)

Dim tempx, tempy, tox, toy, king As Integer

tempx = frmGame.counters(id).x

tempy = frmGame.counters(id).y

 

'give full range of moves if king

If frmGame.counters(id).king = True Then

king = 3

Else

king = 1

End If

 

 

If frmGame.jumpPossible(frmGame.counters(id)) Then

Do

Select Case GetRandom(0, king)

Case 0

tox = tempx + 2

toy = tempy - 2

Case 1

tox = tempx - 2

toy = tempy - 2

Case 2

tox = tempx + 2

toy = tempy + 2

Case 3

tox = tempx - 2

toy = tempy + 2

End Select

 

Loop While frmGame.validMove(frmGame.counters(id), tox, toy) = False

Else

'single move

Do

'give a random space for the piece to move

Select Case GetRandom(0, king)

Case 0

tox = tempx + 1

toy = tempy - 1

Case 1

tox = tempx - 1

toy = tempy - 1

Case 2

tox = tempx + 1

toy = tempy + 1

Case 3

tox = tempx - 1

toy = tempy + 1

End Select

 

Loop While frmGame.validMove(frmGame.counters(id), tox, toy) = False

End If

 

'move the piece to the safe location

frmGame.movePiece(tox, toy)

End Sub

 

'from https://stackoverflow.com/questions/18676/random-int-in-vb-net

Public Function GetRandom(ByVal Min As Integer, ByVal Max As Integer) As Integer

Dim Generator As System.Random = New System.Random()

Return Generator.Next(Min, Max)

End Function

End Class

 

 

Public counters(23) As counter

Dim sqsize As Integer ' size of each piece on the board

Dim offx, offy As Integer 'the offsets for the baord from the top and bottom

Dim turn As Char 'records whose go it is

Dim selectedpiece As Integer = 99 'records if a piece has been picked up

 

'set up AI pieces

Dim BlackAI As AI

Dim WhiteAI As AI

 

Public Property playerBlack As Integer

Public Property playerWhite As Integer

 

Private Sub frmGame_Load(sender As Object, e As EventArgs) Handles MyBase.Load

 

'initiate all the counters

counters(0) = New counter(0, 0, " B")

counters(1) = New counter(2, 0, " B")

counters(2) = New counter(4, 0, " B")

counters(3) = New counter(6, 0, " B")

counters(4) = New counter(1, 1, " B")

counters(5) = New counter(3, 1, " B")

counters(6) = New counter(5, 1, " B")

counters(7) = New counter(7, 1, " B")

counters(8) = New counter(0, 2, " B")

counters(9) = New counter(2, 2, " B")

counters(10) = New counter(4, 2, " B")

counters(11) = New counter(6, 2, " B")

counters(12) = New counter(1, 7, " W")

counters(13) = New counter(3, 7, " W")

counters(14) = New counter(5, 7, " W")

counters(15) = New counter(7, 7, " W")

counters(16) = New counter(0, 6, " W")

counters(17) = New counter(2, 6, " W")

counters(18) = New counter(4, 6, " W")

counters(19) = New counter(6, 6, " W")

counters(20) = New counter(1, 5, " W")

counters(21) = New counter(3, 5, " W")

counters(22) = New counter(5, 5, " W")

counters(23) = New counter(7, 5, " W")

 

'set timers

lblBlackTime.Text = 600

lblWhiteTime.Text = 600

 

offx = 44

offy = 44

 

sqsize = 30

 

 

turn = " B"

loadPlayers(frmLogin.playerId1, frmLogin.playerId2)

 

'set up the AI if necessary

If lblBlackName.Text = " COMPUTER" Then

BlackAI = New AI

BlackAI.colour = " B"

AIMove()

End If

 

 

If lblWhiteName.Text = " COMPUTER" Then

WhiteAI = New AI

WhiteAI.colour = " W"

End If

 

'load the timer

lblBlackTime.Text = frmLogin.lstTime.Value

lblWhiteTime.Text = frmLogin.lstTime.Value

 

End Sub

 

Public Sub AIMove()

If lblBlackName.Text = " COMPUTER" And turn = " B" Then

BlackAI.findMoves()

BlackAI.makeMove()

End If

 

 

If lblWhiteName.Text = " COMPUTER" And turn = " W" Then

WhiteAI.findMoves()

WhiteAI.makeMove()

End If

End Sub

 

Private Sub loadPlayers(id1, id2)

' load the player details into the labels on the page

 

Dim ds As New DataSet

dbConnector.connect()

dbConnector.reset()

 

If frmLogin.chkAIBlack.Checked = False Then

ds = dbConnector.SQLselect(" SELECT Username FROM tblUsers WHERE ID = " & id1)

lblBlackName.Text = ds.Tables(" Results").Rows(0).Item(0)

Else

lblBlackName.Text = " COMPUTER"

End If

 

dbConnector.reset()

ds.Reset()

If frmLogin.chkAIWhite.Checked = False Then

ds = dbConnector.SQLselect(" SELECT Username FROM tblUsers WHERE ID = " & id2)

lblWhiteName.Text = ds.Tables(" Results").Rows(0).Item(0)

Else

lblWhiteName.Text = " COMPUTER"

End If

End Sub

 

Public Sub selectPiece(bx, by)

' either selects or changes selection of piece

For n = 0 To 23

counters(n).selected = False

 

If (counters(n).live = True) And (counters(n).colour = turn) Then

If (counters(n).x = bx) And (counters(n).y = by) Then

counters(n).selected = True

selectedpiece = n

 

End If

End If

Next

End Sub

 

Public Sub movePiece(bx, by)

 

'if it is a move then check that it is valid move

' remove pieces

' change turn

 

If selectedpiece < > 99 Then

 

If validMove(counters(selectedpiece), bx, by) Then

Dim tempx As Integer = 0

Dim tempy As Integer = 0

 

'delete any intermediate counter

If (counters(selectedpiece).x - bx) ^ 2 > 1 Or (counters(selectedpiece).y - by) ^ 2 > 1 Then

 

 

tempx = (counters(selectedpiece).x + bx) / 2

tempy = (counters(selectedpiece).y + by) / 2

 

deletePiece(tempx, tempy)

End If

 

'move piece to the new location

counters(selectedpiece).move(bx, by)

 

'can they make another legal move if they have jumped NOT single move

If jumpPossible(counters(selectedpiece)) And tempx < > 0 Then

counters(selectedpiece).selected = True

'don't allow player to make another move

Else

'change turns and reset selected pieces

changeTurn()

selectedpiece = 99

End If

End If

End If

 

'eng game if no more moves are possible

If finishGame(turn) < > " False" Then

GameOver(finishGame(turn))

End If

 

'paint the board to the screen

Invalidate()

End Sub

 

Private Sub frmGame_MouseClick(sender As Object, e As MouseEventArgs) Handles Me.MouseClick

Dim bx, by As Integer

 

'calculate the box being clicked

bx = Math.Floor(((e.X - offx) / sqsize) + 0)

by = Math.Floor(((e.Y - offy) / sqsize) + 0)

 

selectPiece(bx, by)

movePiece(bx, by)

 

'makes an AI move if needed

AIMove()

End Sub

 

Private Sub frmGame_MouseMove(sender As Object, e As MouseEventArgs) Handles Me.MouseMove

'for debugging the mouse click location

lblmx.Text = e.X

lblmy.Text = e.Y

End Sub

 

Private Sub frmGame_Paint(sender As Object, e As PaintEventArgs) Handles Me.Paint

'draws the screen and board

Dim tempcol As Brush

Dim pallete As Drawing.Graphics = Me.CreateGraphics

 

drawBoard(pallete, tempcol)

drawPieces(pallete, tempcol)

End Sub

 

Private Sub drawBoard(ByRef g, ByRef tempcol)

'draw the board

 

For x = 0 To 7

For y = 0 To 7

'make chequer pattern

If (x + y) Mod 2 = 1 Then

tempcol = Brushes.Black

Else

tempcol = Brushes.Coral

End If

'draw the square

g.FillRectangle(tempcol, (x * sqsize) + offx, (y * sqsize) + offy, sqsize, sqsize)

 

Next

Next

End Sub

 

Private Sub drawPieces(ByRef g, ByRef tempcol)

' draw the pieces

For n = 0 To 23

If counters(n).live = True Then

 

If counters(n).king = True Then

tempcol = Brushes.Black

g.FillEllipse(tempcol, (counters(n).x * sqsize) + (offx - 2), (counters(n).y * sqsize) + (offy - 2), sqsize, sqsize)

End If

 

' set the correct colours

If counters(n).colour = " B" And counters(n).selected = True Then

tempcol = Brushes.Black

End If

 

If counters(n).colour = " B" And counters(n).selected = False Then

tempcol = Brushes.Purple

End If

 

 

If counters(n).colour = " W" And counters(n).selected = True Then

tempcol = Brushes.White

End If

 

If counters(n).colour = " W" And counters(n).selected = False Then

tempcol = Brushes.Gray

End If

 

'draw to screen

g.FillEllipse(tempcol, (counters(n).x * sqsize) + offx, (counters(n).y * sqsize) + offy, sqsize, sqsize)

 

End If

 

Next

 

End Sub

 

Private Function validMove(ByRef origin, x, y)

 

'cannot move to a black square

If (x + y) Mod 2 = 1 Then

Return False

End If

 

'cannot move into an occupied space

If freeSpace(x, y) = False Then

Return False

End If

 

' cannot move backwards

If origin.king = False Then

If origin.colour = " B" And y < origin.y Then

Return False

End If

 

If origin.colour = " W" And y > origin.y Then

Return False

End If

End If

 

' move outside board?

If moveInside(x, y) = False Then

Return False

End If

 

' move on self

If x = origin.x And y = origin.y Then

Return False

End If

 

'jumped too many spaces

If (origin.x - x) ^ 2 > 4 Or (origin.y - y) ^ 2 > 4 Then

Return False

End If

 

Dim tempx, tempy As Integer

tempx = (origin.x + x) / 2

tempy = (origin.y + y) / 2

 

 

'tried to jump own piece

If (origin.x - x) ^ 2 = 4 Or (origin.y - y) ^ 2 = 4 Then

For n = 0 To 23

If counters(n).x = tempx And counters(n).y = tempy And origin.colour = counters(n).colour And counters(n).live Then

Return False

End If

Next

End If

 

'tried to jump blank space

If (origin.x - x) ^ 2 = 4 Or (origin.y - y) ^ 2 = 4 Then

Dim trackenemy As Boolean = False

 

For n = 0 To 23

If counters(n).x = tempx And counters(n).y = tempy And origin.colour < > counters(n).colour And counters(n).live Then

trackenemy = True

End If

Next

 

If trackenemy = False Then

Return False

End If

End If

 

 

'else

Return True

End Function

 

Private Function movePossible(origin)

'move is possible if either jump or sinlgle space moves are possible

If jumpPossible(origin) Or normalMovePossible(origin) Then

Return True

Else

Return False

End If

 

End Function

 

Private Function normalMovePossible(origin)

' is a normal single space move possible?

If origin.colour = " B" And moveBlackPossible(origin) Then

Return True

End If

 

If origin.colour = " W" And moveWhitePossible(origin) Then

Return True

End If

 

'' for Kings

If origin.king = True And (moveWhitePossible(origin) Or moveBlackPossible(origin)) Then

Return True

End If

 

Return False

 

End Function

 

Private Function moveBlackPossible(origin)

'checks squares below the current position

If freeSpace(origin.x + 1, origin.y + 1) Then

Return True

End If

If freeSpace(origin.x - 1, origin.y + 1) Then

Return True

End If

 

Return False

End Function

 

Private Function moveWhitePossible(origin)

'checks squares above the current position

If freeSpace(origin.x + 1, origin.y - 1) Then

Return True

End If

If freeSpace(origin.x - 1, origin.y - 1) Then

Return True

End If

 

Return False

End Function

 

Private Function jumpPossible(origin)

' is a jump move possible?

'' for Kings

If origin.king = True And (jumpUpPossible(origin) Or jumpDownPossible(origin)) Then

Return True

End If

 

If origin.colour = " B" Then

If jumpDownPossible(origin) Then

Return True

End If

End If

 

If origin.colour = " W" Then

If jumpUpPossible(origin) Then

Return True

End If

 

End If

 

Return False

 

End Function

 

Private Function jumpDownPossible(origin)

If freeSpace(origin.x + 1, origin.y + 1) = False And freeSpace(origin.x + 2, origin.y + 2) = True Then

If retColourSquare(origin.x + 1, origin.y + 1) < > origin.colour Then

Return True

End If

End If

If freeSpace(origin.x - 1, origin.y + 1) = False And freeSpace(origin.x - 2, origin.y + 2) = True Then

If retColourSquare(origin.x - 1, origin.y + 1) < > origin.colour Then

Return True

End If

End If

 

Return False

End Function

 

Private Function jumpUpPossible(origin)

If freeSpace(origin.x + 1, origin.y - 1) = False And freeSpace(origin.x + 2, origin.y - 2) = True Then

If retColourSquare(origin.x + 1, origin.y - 1) < > origin.colour Then

Return True

End If

End If

If freeSpace(origin.x - 1, origin.y - 1) = False And freeSpace(origin.x - 2, origin.y - 2) = True Then

If retColourSquare(origin.x - 1, origin.y - 1) < > origin.colour Then

Return True

End If

End If

 

Return False

End Function

 

Private Function moveInside(x, y)

'checks that the move is within the board

If x > 7 Or x < 0 Or y > 7 Or y < 0 Then

Return False

End If

 

Return True

End Function

 

'is the space being looked at free?

Private Function freeSpace(x, y)

If moveInside(x, y) = False Then

Return False

End If

 

For n = 0 To 23

If counters(n).x = x And counters(n).y = y And counters(n).live Then

Return False

End If

Next

 

Return True

 

End Function

 

Private Function retColourSquare(x, y)

'returns the colour of a counter on a given square

For n = 0 To 23

If counters(n).x = x And counters(n).y = y And counters(n).live Then

Return counters(n).colour

End If

Next

Return " Blank"

End Function

 

Private Function finishGame(colour)

'finish game?

Dim countwhite As Integer = 0

Dim countblack As Integer = 0

 

For n = 0 To 23

If counters(n).live Then

If counters(n).colour = " W" Then

countwhite = countwhite + 1

ElseIf counters(n).colour = " B" Then

countblack = countblack + 1

End If

End If

Next

 

'if no counters left or time run out

If countblack = 0 Or lblBlackTime.Text < = 0 Then

MsgBox(" Game over! White wins")

Return " White"

End If

 

If countwhite = 0 Or lblWhiteTime.Text < = 0 Then

MsgBox(" Game over! Black wins")

Return " Black"

End If

 

' check that no moves are possible for all pieces

For n = 0 To 23

If counters(n).colour = colour And movePossible(counters(n)) And counters(n).live Then

Return " False"

End If

Next

 

Return " Draw"

End Function

 

Private Function deletePiece(x, y)

'removes a piece when jumping it

For n = 0 To 23

If counters(n).x = x And counters(n).y = y Then

counters(n).die()

Return True

End If

Next

 

MsgBox(" Error can't find piece to delete at" & x & ", " & y)

 

Return False

End Function

 

Private Sub changeTurn()

'change turn

If turn = " W" Then

turn = " B"

lblBlackName.Text = " => " & lblBlackName.Text

lblWhiteName.Text = lblWhiteName.Text.Replace(" =", " ")

lblWhiteName.Text = lblWhiteName.Text.Replace(" > ", " ")

 

Else

turn = " W"

lblWhiteName.Text = " => " & lblWhiteName.Text

lblBlackName.Text = lblBlackName.Text.Replace(" =", " ")

lblBlackName.Text = lblBlackName.Text.Replace(" > ", " ")

End If

toggleTimer()

End Sub

 

Private Sub toggleTimer()

'change the timer from one side to another

If tmrBlack.Enabled = True Then

tmrBlack.Enabled = False

tmrWhite.Enabled = True

Else

tmrBlack.Enabled = True

tmrWhite.Enabled = False

End If

End Sub

 

Private Sub GameOver(result)

'Game Over Script

Dim sql As String

Dim winner As Integer

 

If result = " Black" Then

winner = playerBlack

End If

If result = " White" Then

winner = playerWhite

End If

If result = " Draw" Then

winner = 0

End If

 

tmrBlack.Enabled = False

tmrWhite.Enabled = False

 

MsgBox(result)

 

'save game

'only save games where players are ALL human

If frmLogin.chkAIBlack.Checked = False And frmLogin.chkAIWhite.Checked = False Then

dbConnector.connect()

sql = " INSERT INTO tblGame (GameDate, WhitePlayer, BlackPlayer, Winner)"

sql += " VALUES ('" & Date.Now() & " ', " & playerWhite & ", " & playerBlack & ", " & winner & "); "

 

dbConnector.SQLinsert(sql)

End If

 

frmScores.Show()

Me.Close()

 

End Sub

 

Private Sub tmrBlack_Tick(sender As Object, e As EventArgs) Handles tmrBlack.Tick

'decrease the clock by one second

lblBlackTime.Text = lblBlackTime.Text - 1

End Sub

 

Private Sub tmrWhite_Tick(sender As Object, e As EventArgs) Handles tmrWhite.Tick

'decrease the clock by one second

lblWhiteTime.Text = lblWhiteTime.Text - 1

End Sub

End Class


(iii) Testing [5 marks]

An attempt should be made to show that all parts of the system have been tested, including those sections dealing with unexpected or invalid data as well as extreme cases. Showing that many other cases of test data are likely to work – by including the outputs that they produce – is another important feature. Evidence of testing is essential. Comments by teachers and others are of value, but the test plan must be supported by evidence in the report of a properly designed testing process. The examiner must be left in no doubt that the system actually works to the satisfaction of the client. This evidence may be in the form of hardcopy output and screen dumps.

 

Example 4b: library system project.

 

(iii) Testing (4/5 marks) Mark Comments
  A collection of hardcopy test run outputs with no test plan, or a test plan with no hardcopy evidence may also be present. A teacher may award 1 mark if they have been shown the system working satisfactorily and there is no hard evidence in the project report.   Teacher’s comment – evidence for every test run is provided. Examiner’s comment – there is cross-referenced hard copy evidence for at least 8 test runs
  There is little evidence of testing with a badly developed test plan with clear omissions. There is no description of the relationship between the structure of the development work and the testing in evidence.  
3-4 There should be hardcopy evidence from at least eight different test runs cross-referenced to the test plan. However, not all cases have been tested.  
  Evidence of each test run cross-referenced to the test plan is present in the report. Testing should include as many different paths through the system as is feasible, including valid, invalid and extreme cases. Marks may be lost for lack of evidence of a particular test run.  

Поделиться с друзьями:

mylektsii.su - Мои Лекции - 2015-2024 год. (0.107 сек.)Все материалы представленные на сайте исключительно с целью ознакомления читателями и не преследуют коммерческих целей или нарушение авторских прав Пожаловаться на материал