VB.Net - Pascal's Pyramid
Overview
Pascal's Pyramid is an original card game, played with an irregular deck of cards. The game board (or pyramid) is loosely based on Pascal's Triangle, which is a triangular array of the binomial coefficients. Each deck contains 20 aces, 4 each of numbers 2 to 10 inclusive, and 2 sets of face cards, which is 80 cards in total. The aim of the game is to build the pyramid with cards in a predefined order. It isn't possible to play an illegal move - the hexagon cells in the pyramid will only allow legal moves. Each deal from the deck gives you three new cards that you can either use or discard.
To deal a new hand you simply doubleclick the deck. To play a card you can either drag and drop it on a cell, or doubleclick the card and it'll play on the leftmost available target cell. There are 64 playable cells in the pyramid.
As a mainly graphical game, with minimal Controls used, there's a lot of drawing code, and alongside rendering the game, frmGame also coordinates the entire game. There are four core Class Objects...
- Card - represents a card Object
- Deck - contains methods for creating, shuffling, and dealing from the deck.
- Cell - represents a single hexagonal game cell
- FaceCard - used in rendering the pyramid.
The top card in a dealt hand is displayed in a draggable extended PictureBox.
This game is written in VB2008, to maximise application scope in terms of opening in VB. As such, it'll run in any version of VB from 2008 to 2017, only requiring a minimum of 3.5 Framework.
This is a fairly lengthy application in terms of code, so this article will only focus on the extended PictureBox, and the four Class Objects...
The CardPictureBox
This extended PictureBox Control allows (and disallows) dragging, and raises a Dropped Event when released.
Public Class CardPictureBox
Inherits PictureBox
Public Event Dropped()
Declare Function GetDoubleClickTime Lib "user32.dll" () As Integer
Private lastClicked As Integer = -1
Private _frozen As Boolean = False
Public Property frozen() As Boolean
Get
Return _frozen
End Get
Set(ByVal value As Boolean)
_frozen = value
End Set
End Property
''' <summary>
''' Overridden MouseDown
''' </summary>
''' <param name="e"></param>
''' <remarks>Provides built in draggable functionality</remarks>
Protected Overrides Sub OnMouseDown(ByVal e As System.Windows.Forms.MouseEventArgs)
If lastClicked > -1 Then
If Environment.TickCount - lastClicked < GetDoubleClickTime() Then
Return
End If
End If
lastClicked = Environment.TickCount
MyBase.OnMouseDown(e)
If MyBase.Image Is Nothing Or frozen Then Return
Me.BringToFront()
Me.Capture = False
Const WM_NCLBUTTONDOWN As Integer = &HA1
Const HTCAPTION As Integer = &H2
Dim msg As Message = _
Message.Create(Me.Handle, WM_NCLBUTTONDOWN, _
New IntPtr(HTCAPTION), IntPtr.Zero)
Me.DefWndProc(msg)
RaiseEvent Dropped()
Me.Location = New Point(258, 619)
End Sub
End Class
The PicTopCard_DoubleClick EventHandler
Doubleclicking the extended PictureBox will 'play' the displayed card to the first legal available target cell.
Private Sub PicTopCard_DoubleClick(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles PicTopCard.DoubleClick
If frozen Then Return
For y As Integer = 10 To 0 Step -1
For x As Integer = 0 To y
If cells(y)(x).fillState = Cell.cellState.target And
hand(0).getSuit Like cells(y)(x).getSuit And
cells(y)(x).getValue = hand(0).getValue Then
dropCard(x, y)
Return
End If
Next
Next
End Sub
The PicTopCard_Move EventHandler
The Move Event is used for highlighting target cells, when the card is dragged over them.
Private Sub PicTopCard_Move(ByVal sender As Object, ByVal e As System.EventArgs) Handles PicTopCard.Move
If cells(0) Is Nothing Then Return
highlightCell = Nothing
For y As Integer = 10 To 0 Step -1
For x As Integer = 0 To y
If cells(y)(x).cardover(PicTopCard.Bounds) = True Then
If cells(y)(x).fillState = Cell.cellState.target And
hand(0).getSuit Like cells(y)(x).getSuit And
cells(y)(x).getValue = hand(0).getValue Then
highlightCell = New Point(x, y)
Me.Refresh()
Return
End If
End If
Next
Next
Me.Refresh()
End Sub
The PicTopCard_Dropped EventHandler
The custom Dropped EventHandler notifies the Form when a card is dropped.
Private Sub PicTopCard_Dropped() Handles PicTopCard.Dropped
If Not highlightCell = Nothing Then
Dim x As Integer = highlightCell.X
Dim y As Integer = highlightCell.Y
If cells(y)(x).fillState = Cell.cellState.target And
hand(0).getSuit Like cells(y)(x).getSuit And
cells(y)(x).getValue = hand(0).getValue Then
dropCard(x, y)
End If
End If
End Sub
The core Classes
The Card Class
This represents a playing card and contains just a constructor and three ReadOnly Properties - Suit, Value, and Image.
Public Class Card
Private suit As String
Private value As String
Private image As Bitmap
Public Sub New(ByVal suit As String, ByVal value As String, ByVal cardImage As Bitmap)
Me.suit = suit
Me.value = value
Me.image = cardImage
End Sub
Public ReadOnly Property getSuit() As String
Get
Return Me.suit
End Get
End Property
Public ReadOnly Property getValue() As String
Get
Return Me.value
End Get
End Property
Public ReadOnly Property getImage() As Bitmap
Get
Return Me.image
End Get
End Property
End Class
The Deck Class
This represents the deck or collection of playing cards and has a default constructor, one ReadOnly Property, two Public methods, and one Private method. These methods create the deck, shuffle the deck, and deal out cards from the deck.
Public Class Deck
Private theDeck As New List(Of Card)
Private r As New Random
Public ReadOnly Property getDeck() As List(Of Card)
Get
Return theDeck
End Get
End Property
Public Sub New()
Me.createDeck()
End Sub
Public Sub createDeck()
Me.theDeck = New List(Of Card)
Dim JQK() As String = {"J", "Q", "K"}
Dim suits() As String = {"C", "D", "H", "S"}
For x As Integer = 1 To 2
For Each c As String In JQK
Me.getDeck.Add(New Card("Clubs", c, DirectCast(My.Resources.ResourceManager.GetObject(c & suits(0)), Bitmap)))
Me.getDeck.Add(New Card("Diamonds", c, DirectCast(My.Resources.ResourceManager.GetObject(c & suits(1)), Bitmap)))
Me.getDeck.Add(New Card("Hearts", c, DirectCast(My.Resources.ResourceManager.GetObject(c & suits(2)), Bitmap)))
Me.getDeck.Add(New Card("Spades", c, DirectCast(My.Resources.ResourceManager.GetObject(c & suits(3)), Bitmap)))
Next
Next
For x As Integer = 1 To 5
Me.getDeck.Add(New Card("Clubs", "1", DirectCast(My.Resources.ResourceManager.GetObject("_1" & suits(0)), Bitmap)))
Me.getDeck.Add(New Card("Diamonds", "1", DirectCast(My.Resources.ResourceManager.GetObject("_1" & suits(1)), Bitmap)))
Me.getDeck.Add(New Card("Hearts", "1", DirectCast(My.Resources.ResourceManager.GetObject("_1" & suits(2)), Bitmap)))
Me.getDeck.Add(New Card("Spades", "1", DirectCast(My.Resources.ResourceManager.GetObject("_1" & suits(3)), Bitmap)))
Next
For x As Integer = 2 To 10
Me.getDeck.Add(New Card("Clubs", x.ToString, DirectCast(My.Resources.ResourceManager.GetObject("_" & x.ToString & suits(0)), Bitmap)))
Me.getDeck.Add(New Card("Diamonds", x.ToString, DirectCast(My.Resources.ResourceManager.GetObject("_" & x.ToString & suits(1)), Bitmap)))
Me.getDeck.Add(New Card("Hearts", x.ToString, DirectCast(My.Resources.ResourceManager.GetObject("_" & x.ToString & suits(2)), Bitmap)))
Me.getDeck.Add(New Card("Spades", x.ToString, DirectCast(My.Resources.ResourceManager.GetObject("_" & x.ToString & suits(3)), Bitmap)))
Next
Me.shuffleDeck()
End Sub
Private Sub shuffleDeck()
theDeck = theDeck.OrderBy(Function(c) r.NextDouble).ToList
End Sub
Public Function deal() As List(Of Card)
Dim dealt As New List(Of Card)
For x As Integer = 1 To 3
dealt.Add(Me.getDeck().First)
Me.getDeck.RemoveAt(0)
Next
Return dealt
End Function
End Class
The Cell Class
Each instance of this class represents one hexagon cell in the pyramid game board. As with the Card Class, it also has a Suit Property, and a Value Property, and also a FillState Property, which can be one of four values...
- empty
- filled
- target
- fixed
Also the Cell Class has a Boolean cardOver Function, used along with the Properties when matching Cells to Cards.
Public Class Cell
Private suit As String
Private value As String
Private hexPoints() As Point
Private state As cellState
Public Enum cellState
empty = 0
filled = 1
target = 2
fixed = 3
End Enum
Public Sub New()
End Sub
Public Sub New(ByVal suit As String, ByVal value As String, ByVal hexPoints() As Point)
Me.suit = suit
Me.value = value
Me.hexPoints = hexPoints
End Sub
Public ReadOnly Property getSuit() As String
Get
Return Me.suit
End Get
End Property
Public ReadOnly Property getValue() As String
Get
Return Me.value
End Get
End Property
Public ReadOnly Property getHexPoints() As Point()
Get
Return Me.hexPoints
End Get
End Property
Public Property fillState() As cellState
Get
Return Me.state
End Get
Set(ByVal value As cellState)
Me.state = value
End Set
End Property
Public Function cardover(ByVal r As Rectangle) As Boolean
If Me.hexPoints Is Nothing Then Return False
Return Me.hexPoints.Any(Function(p) r.Contains(p))
End Function
End Class
The FaceCard Class
This is used when rendering the game board. The images are silver hexagons with either J, Q, K and a suit character. The ReadOnly Suit and Value Properties are used when setting up the triangular Cells array in the main Form.
Public Class FaceCard
Private image As Bitmap
Private suit As String
Private value As String
Public Sub New(ByVal image As Bitmap, ByVal suit As String, ByVal value As String)
Me.image = image
Me.suit = suit
Me.value = value
End Sub
Public Function getImage() As Bitmap
Return Me.image
End Function
Public ReadOnly Property getSuit() As String
Get
Return Me.suit
End Get
End Property
Public ReadOnly Property getValue() As String
Get
Return Me.value
End Get
End Property
End Class
Conclusion
For a game of its complexity, this is a fairly lightweight application, which hopefully demonstrates how to develop a card game in VB.Net. GDI+ is a versatile Class containing useful and usable methods. Drawing with GDI+ is only limited by your imagination...
Articles related to game programming
VB.Net - WordSearch
VB.Net - Vertex
VB.Net - Perspective
VB.Net - MasterMind
VB.Net - OOP BlackJack
VB.Net - Numbers Game
VB.Net - HangMan
Console BlackJack - VB.Net | C#
TicTacToe - 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 - Split Decisions
VB.Net - Three-card Monte
VB.Net - Random Maze Games
(Office) Wordsearch Creator
VB.Net - Event Driven Programming - LockWords Game
C# - Crack the Lock
VB.Net - Totris