VB.Net - Vertex (Game)
Overview
This is an original strategy game, written in VB2008 (for wider platform compatibility).
The aim of the game is to beat your opponent (your computer) in a race to claim the top vertex, through a progression of legal moves.
How to play...
.gif){kind=link}
Click the above How to play header or this animated gif (in a different window) to see a demo.
Youtube video - (If the embedded video doesn't appear, use this external link: https://youtu.be/wDmSv-rQcoE) - View
Each player is randomly allocated 1-4 chips each time it's their turn. Every one of your 1-4 chips will be red and your opponents will be yellow. Along the way to the top vertex, there are two randomly positioned power vertexes which will give you (for one power) a 1 in 8 chance for each chip allocated to you will be a 'wild' chip. For two powers, you'll have a 1 in 5 chance of your chips being a 'wild' chip.
An icon drawn on the vertex denotes a power vertex...
Chips and moves
The chips and their legal moves are...
Red
Can be played either as a free turn on the bottom left vertex at the start of a new game, or in any other case, only beside or above another Red or a RedWild chip, progressing chip by chip towards the top vertex.
RedWild
Can be played either as a Red chip, but also may be played beside or above any other chip, for blocking your opponents progress.
Yellow
This is your opponents chip and follows the same rules as a Red chip with the bottom right vertex being the free move.
YellowWild
This is your opponents 'wild' chip and follows the same rules as a RedWild chip.
The core.Game Class
The Game Class is the singleton Class used for the duration of gameplay. It contains several Public Methods - the Public Function drawChips, the **Public Function **
isValidMove, and the Public Function play. These are used both internally within the Game Class, and they're also called from the main form (frmGame). It also contains six Private methods which are exclusively used within the Game Class where they contribute to the opponent's (computer's) gameplay algorithm.
Public Class game
Private r As New Random
Private canWin As Boolean = False
Private canWin2 As Boolean = False
Private canWin3 As Boolean = False
''' <summary>
''' drawChips Function
''' </summary>
''' <param name="chips"></param>
''' <param name="img1"></param>
''' <param name="img2"></param>
''' <param name="player"></param>
''' <param name="hasTargets"></param>
''' <returns></returns>
''' <remarks>Allocates the player a random number (1 to 4) of chips
''' which each have a 1 in 8 chance of being a wild chip (with one power)
''' or 1 in 5 (with two powers)</remarks>
Public Function drawChips(ByVal chips() As chipPictureBox, ByVal img1 As Bitmap, ByVal img2 As Bitmap, ByVal player As String, ByVal hasTargets() As Integer) As Integer
Dim max As Integer
If player.StartsWith("r") Then
max = If (hasTargets(0) = 1, 8, If (hasTargets(0) = 2, 5, -1))
ElseIf player.StartsWith("y") Then
max = If (hasTargets(1) = 1, 8, If (hasTargets(1) = 2, 5, -1))
End If
Dim n As Integer = r.Next(1, Math.Max(4, r.Next(1, 6)))
For x As Integer = 0 To 3
Dim t As Integer = 0
If max > -1 Then
t = r. Next (0, max)
End If
chips(x).Image = If (x < n, If (t = 3, img2, img1), Nothing )
chips(x).Visible = If (x < n, True , False )
chips(x).canDrag = player = "r" And x < n
chips(x).chipType = If (x < n, If (t = 3, player & "w" , player), "")
Next
Return n
End Function
''' <summary>
''' isValidMove Function
''' </summary>
''' <param name="v"></param>
''' <param name="x"></param>
''' <param name="y"></param>
''' <param name="t"></param>
''' <returns></returns>
''' <remarks>Used to identify a valid vertex, i.e. unoccupied and a legal move</remarks>
Public Function isValidMove(ByVal v()() As vertexInfo, ByVal x As Integer, ByVal y As Integer, ByVal t As String) As Boolean
Dim isValid As Boolean = If(t = "r" Or t = "rw", x = 0 And y = 9, x = 9 And y = 9)
If x > 0 Then
If t.EndsWith("w") Then
isValid = isValid Or v(y)(x - 1).chipType <> ""
Else
isValid = isValid Or v(y)(x - 1).chipType.StartsWith(t)
End If
End If
If x < v(y).GetUpperBound(0) Then
If t.EndsWith("w") Then
isValid = isValid Or v(y)(x + 1).chipType <> ""
Else
isValid = isValid Or v(y)(x + 1).chipType.StartsWith(t)
End If
End If
If y < 9 Then
If t.EndsWith("w") Then
isValid = isValid Or v(y + 1)(x).chipType <> "" Or v(y + 1)(x + 1).chipType <> ""
Else
isValid = isValid Or v(y + 1)(x).chipType.StartsWith(t) Or v(y + 1)(x + 1).chipType.StartsWith(t)
End If
End If
If isValid And Not String.IsNullOrEmpty(v(y)(x).chipType) Then
Return False
End If
Return isValid
End Function
''' <summary>
''' checkPath Function
''' </summary>
''' <param name="v"></param>
''' <param name="d"></param>
''' <param name="x"></param>
''' <param name="y"></param>
''' <param name="t"></param>
''' <param name="targetLocation"></param>
''' <returns></returns>
''' <remarks>Used to find the shortest valid path</remarks>
Private Function checkPath(ByVal v()() As vertexInfo, ByVal d()() As vertexDetails, _
ByVal x As Integer, ByVal y As Integer, ByVal t As String, ByVal targetLocation As Point, ByVal block As Boolean) As List(Of pathDetails)
Dim details(9)() As vertexDetails
If d Is Nothing Then
For r As Integer = 9 To 0 Step -1
Dim row As New List(Of vertexDetails)
For i As Integer = 0 To r
row.Add( New vertexDetails() With {.player = If(Not String.IsNullOrEmpty(v(r)(i).chipType), v(r)(i).chipType.Substring(0, 1), "")})
Next
details(r) = row.ToArray
Next
Else
details = d
End If
'Stop
canWin = False
Dim path As New List(Of pathDetails)
checkPath2(details, x, y, t, path, targetLocation)
canWin2 = False
Dim path2 As New List(Of pathDetails)
checkPath4(details, x, y, t, path2, targetLocation)
path = path.Where( Function (vi) String .IsNullOrEmpty(vi.occupied)).ToList
path2 = path2.Where( Function (vi) String .IsNullOrEmpty(vi.occupied)).ToList
If path.Count < path2.Count Then
If canWin Then
Return path
Else
Return path2
End If
Else
If canWin2 And Not block Then
Return path2
Else
Return path
End If
End If
End Function
''' <summary>
''' checkPath2 Method
''' </summary>
''' <param name="v"></param>
''' <param name="x"></param>
''' <param name="y"></param>
''' <param name="t"></param>
''' <param name="path"></param>
''' <param name="targetLocation"></param>
''' <remarks>Called recursively to find the shortest valid path</remarks>
Private Sub checkPath2(ByVal v()() As vertexDetails, ByVal x As Integer, ByVal y As Integer, _
ByVal t As String, ByVal path As List(Of pathDetails), ByVal targetLocation As Point)
If canWin Then Return
'If x > y Then Return
v(y)(x).visited = True
If t = "y" Then
If Not v(y)(x).player.StartsWith("y") AndAlso Not String.IsNullOrEmpty(v(y)(x).player) Then Return
End If
If y < targetLocation.Y Then Return
path.Add( New pathDetails With {.i = x, .r = y, .occupied = v(y)(x).player})
If y = targetLocation.Y And x = targetLocation.X Then
canWin = True
Return
End If
Dim distance As Integer = Math.Abs(targetLocation.Y - y) + Math.Abs(targetLocation.X - x)
Dim newDistance(3) As Integer
newDistance(0) = Math.Abs(targetLocation.Y - (y - 1)) + Math.Abs(targetLocation.X - (x - 1))
newDistance(1) = Math.Abs(targetLocation.Y - (y - 1)) + Math.Abs(targetLocation.X - x)
newDistance(2) = Math.Abs(targetLocation.Y - y) + Math.Abs(targetLocation.X - (x + 1))
newDistance(3) = Math.Abs(targetLocation.Y - y) + Math.Abs(targetLocation.X - (x - 1))
If Not newDistance.Any(Function(i) i < distance) Then
newDistance(0) = -1
newDistance(1) = -1
newDistance(2) = -1
newDistance(3) = -1
End If
If newDistance(0) < distance AndAlso y > 0 AndAlso x > 0 AndAlso x - 1 <= y - 1 AndAlso Not v(y - 1)(x - 1).visited Then
checkPath2(v, x - 1, y - 1, t, path, targetLocation) 'check vertex above left
End If
If newDistance(1) < distance AndAlso y > 0 AndAlso x <= y - 1 AndAlso Not v(y - 1)(x).visited Then
checkPath2(v, x, y - 1, t, path, targetLocation) 'check vertex above right
End If
If newDistance(2) < distance AndAlso x <= y - 1 AndAlso Not v(y)(x + 1).visited Then
checkPath2(v, x + 1, y, t, path, targetLocation) 'check vertex to right
End If
If newDistance(3) < distance AndAlso x > 0 AndAlso Not v(y)(x - 1).visited Then
checkPath2(v, x - 1, y, t, path, targetLocation) 'check vertex to left
End If
End Sub
''' <summary>
''' checkPath3 Function
''' </summary>
''' <param name="v"></param>
''' <param name="t"></param>
''' <param name="targetLocation"></param>
''' <returns></returns>
''' <remarks>Last Method used to find the shortest valid path</remarks>
Private Function checkPath3(ByVal v()() As vertexInfo, ByVal t As String, ByVal targetLocation As Point, ByVal block As Boolean) As List(Of pathDetails)
For y As Integer = 0 To 9
For x As Integer = 0 To y
If t = "y" AndAlso v(y)(x).chipType.StartsWith(t) Then
Return checkPath(v, Nothing, x, y, t, targetLocation, block)
ElseIf t = "yw" AndAlso Not String.IsNullOrEmpty(v(y)(x).chipType) Then
If x > 0 Then
Return checkPath(v, Nothing, x - 1, y - 1, t, targetLocation, block)
Else
Return checkPath(v, Nothing, x, y - 1, t, targetLocation, block)
End If
End If
Next
Next
Return Nothing
End Function
''' <summary>
''' checkPath4 Method
''' </summary>
''' <param name="v"></param>
''' <param name="x"></param>
''' <param name="y"></param>
''' <param name="t"></param>
''' <param name="path"></param>
''' <param name="targetLocation"></param>
''' <remarks>Called recursively to find the shortest valid path</remarks>
Private Sub checkPath4(ByVal v()() As vertexDetails, ByVal x As Integer, ByVal y As Integer, _
ByVal t As String, ByVal path As List(Of pathDetails), ByVal targetLocation As Point)
If canWin Then Return
'If x > y Then Return
v(y)(x).visited = True
If t = "y" Then
If Not v(y)(x).player.StartsWith("y") AndAlso Not String.IsNullOrEmpty(v(y)(x).player) Then Return
End If
If y < targetLocation.Y Then Return
path.Add( New pathDetails With {.i = x, .r = y, .occupied = v(y)(x).player})
If y = targetLocation.Y And x = targetLocation.X Then
canWin2 = True
Return
End If
Dim dx As Integer = If(targetLocation.X - x < 0, -1, If(targetLocation.X - x > 0, 1, 0))
Dim dy As Integer = If(targetLocation.Y - y < 0, -1, If(targetLocation.Y - y > 0, 1, 0))
If x + dx >= 0 AndAlso x + dx <= v(y).GetUpperBound(0) AndAlso y + dy >= 0 Then
checkPath2(v, x + dx, y + dy, t, path, targetLocation) 'check next closest vertex
End If
End Sub
''' <summary>
''' findClosestOccupiedVertex Function
''' </summary>
''' <param name="targetLocation"></param>
''' <param name="v"></param>
''' <returns></returns>
''' <remarks>Used in calculating the shortest path to a target</remarks>
Private Function findClosestOccupiedVertex(ByVal targetLocation As Point, ByVal v()() As vertexInfo, ByVal t As String) As Point
Dim closest As Integer = Integer.MaxValue
Dim closestPoint As Point
For y As Integer = 9 To 0 Step -1
For x As Integer = 0 To y
If v(y)(x).chipType.StartsWith("y") OrElse (t = "yw" AndAlso v(y)(x).chipType <> "") Then
Dim distance As Integer = Math.Abs(targetLocation.Y - y) + Math.Abs(targetLocation.X - x)
If distance < closest Then
closest = distance
closestPoint = New Point(x, y)
End If
End If
Next
Next
Return closestPoint
End Function
''' <summary>
''' play Function
''' </summary>
''' <param name="cChips"></param>
''' <param name="img1"></param>
''' <param name="img2"></param>
''' <param name="v"></param>
''' <returns></returns>
''' <remarks>Coordinates the computer's gameplay</remarks>
Public Function play(ByVal cChips() As chipPictureBox, ByVal img1 As Bitmap, _
ByVal img2 As Bitmap, ByVal v()() As vertexInfo, ByVal hasTargets() As Integer, _
ByVal ri1 As randomIcon, ByVal ri2 As randomIcon, ByVal targets() As Target) As Boolean
Dim numberOfMoves As Integer = drawChips(cChips, img1, img2, "y", hasTargets)
cChips = cChips.OrderByDescending( Function (p) p.chipType.Length).ToArray
Application.DoEvents()
Threading.Thread.Sleep(500)
Dim counter As Integer
Dim chipCounter As Integer = 0
Dim xV As Integer = 9
Dim yV As Integer = 9
Do
'If cChips(chipCounter).chipType = "yw" Then Stop
Dim target As Target = targets.Last(Function(t) t.acquired = False)
Dim p As Point = findClosestOccupiedVertex(target.location, v, cChips(chipCounter).chipType)
If p <> Point.Empty Then
xV = p.X
yV = p.Y
End If
Dim cMoves As List(Of pathDetails) = checkPath(v, Nothing, xV, yV, cChips(chipCounter).chipType, target.location, cChips(chipCounter).chipType = "yw")
If cMoves Is Nothing OrElse cMoves.Count = 0 Then
If target.location <> Point.Empty Then
target.acquired = True
Continue Do
ElseIf Not (xV = 9 And yV = 9) Then
cMoves = checkPath(v, Nothing , 9, 9, cChips(chipCounter).chipType, Point.Empty, cChips(chipCounter).chipType = "yw" )
End If
End If
Dim cMoves2 As List(Of pathDetails) = checkPath3(v, cChips(chipCounter).chipType, Point.Empty, cChips(chipCounter).chipType = "yw")
If cMoves2 IsNot Nothing AndAlso cMoves2.Count > 0 AndAlso cMoves IsNot Nothing _
AndAlso cMoves2.Count < cMoves.Count AndAlso cChips(chipCounter).chipType <> "yw" Then
If cMoves2(0).r < cMoves(0).r Then
cMoves = cMoves2
End If
End If
If cMoves.Count = 0 Then
If target.location <> Point.Empty Then
target.acquired = True
Continue Do
Else
'pass
My.Computer.Audio.Play(My.Resources.sigh, AudioPlayMode.Background)
Exit Do
End If
End If
If Not cMoves Is Nothing AndAlso Not cMoves.Count = 0 Then
'play cMoves
counter = 0
For x As Integer = 0 To If(cMoves.Count <= numberOfMoves, cMoves.Count - 1, numberOfMoves - 1)
Dim m As New moveDetails With {.cpb = cChips(chipCounter), .vertex = v(cMoves(x).r)(cMoves(x).i), .hasTargets = hasTargets, .ri1 = ri1, .ri2 = ri2, .targets = targets}
moveChip(m)
counter += 1
chipCounter += 1
Next
If v(0)(0).chipType.StartsWith("y") Then counter = numberOfMoves : Return True
numberOfMoves -= counter
End If
Loop While numberOfMoves > 0
For x As Integer = 0 To 3
cChips(x).chipType = ""
cChips(x).Image = Nothing
cChips(x).Visible = False
Next
Return False
End Function
''' <summary>
''' moveChip Method
''' </summary>
''' <param name="m"></param>
''' <remarks>Programmatically moves the computer's chips in an animated fashion
''' Assigns the 'dropped' chip to the highlighted vertex</remarks>
Private Sub moveChip(ByVal m As moveDetails)
Dim origin As Point = m.cpb.Location
Dim endPoint As Point = m.vertex.location
Dim midPoint As New Point
For x As Integer = 0 To 10
midPoint.X = CInt (Math.Min(origin.X, endPoint.X) + (((Math.Max(origin.X, endPoint.X) - Math.Min(origin.X, endPoint.X)) / 10) * (10 - x)))
midPoint.Y = CInt (Math.Min(origin.Y, endPoint.Y) + (((Math.Max(origin.Y, endPoint.Y) - Math.Min(origin.Y, endPoint.Y)) / 10) * (10 - x)))
If midPoint.X < m.cpb.Location.X - 25 Then
midPoint.Offset(-25, -25)
Else
midPoint.Offset(0, -25)
End If
m.cpb.Location = midPoint
Application.DoEvents()
Threading.Thread.Sleep(50)
Next
m.vertex.chipType = m.cpb.chipType
If m.vertex.target > 0 Then
m.hasTargets(1) += 1
If m.ri1.used Then
m.ri2.Image = My.Resources.shuffle_51x51
m.ri2.used = True
Else
m.ri1.Image = My.Resources.shuffle_51x51
m.ri1.used = True
End If
m.targets(m.vertex.target).acquired = True
My.Computer.Audio.Play(My.Resources.floop, AudioPlayMode.Background)
ElseIf m.vertex.target = 0 Then
My.Computer.Audio.Play(My.Resources.floop, AudioPlayMode.Background)
Else
My.Computer.Audio.Play(My.Resources.Jump, AudioPlayMode.Background)
End If
m.cpb.Location = m.cpb.baseLocation
m.cpb.Image = Nothing
m.cpb.chipType = ""
m.cpb.Visible = False
Application.DoEvents()
End Sub
End Class
Conclusion
VB.Net is a much underrated programming language these days, which is a shame as it is equally as versatile as C#.
This example shows how to write a fully functioning PC game. The only limit when designing a game in VB.Net is your imagination. If you can dream it, you can code it...
Other Resources
I've updated the zip file.
New version has the reduced screen size, to be usable in laptops with smaller screens, and minor changes to the gameplay algorithm.
Alternative download from MSDN Samples Gallery
This and other games can be downloaded in executable form at: http://www.scproject.biz/puzzlegames.php
Articles related to game programming
VB.Net - Perspective
VB.Net - WordSearch
VB.Net - MasterMind
VB.Net - OOP BlackJack
VB.Net - Numbers Game
VB.Net - HangMan
Console BlackJack - VB.Net | C#
TicTacToe - VB.Net | C#
OOP Conway's Game of Life - VB.Net | C#
OOP Sudoku - VB.Net | C#
OctoWords VB.Net | C#
OOP Buttons Guessing Game VB.Net | C#
OOP Tangram Shapes Game VB.Net | C#
VB.Net - Three-card Monte
VB.Net - Split Decisions
VB.Net - Pascal's Pyramid
VB.Net - Random Maze Games
(Office) Wordsearch Creator
VB.Net - Event Driven Programming - LockWords Game
C# - Crack the Lock
VB.Net - Totris