Share via


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


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


Download

Download here...