VB.Net: Three-card Monte
Overview
[Quote wiki: https://en.wikipedia.org/wiki/Three-card_Monte]
"Three-card Monte - also known as find the lady and three-card trick - is a confidence game in which the victim, or "mark", is tricked into betting a sum of money, on the assumption that they can find the "money card" among three face-down playing cards. It is the same as the shell game except that cards are used instead of shells.
In its full form, three-card Monte is an example of a classic "short con" in which a shill pretends to conspire with the mark to cheat the dealer, while in fact conspiring with the dealer to cheat the mark. The mark has no chance whatsoever of winning, at any point in the game. In fact, anyone who is observed winning anything in the game can be presumed to be a shill.
This confidence trick was already in use by the turn of the 15th century."
This is a card game based on Three-card Monte, with the exception being, this is the honest version.
The levelControl
This control is hosted in a menuitem and used for setting the speed of card shuffling.
Public Class levelControl
Public Event ValueChanged(sender As Object, e As EventArgs)
Public Property Value() As Integer
Get
Return HScrollBar1.Value
End Get
Set(ByVal value As Integer)
HScrollBar1.Value = value
End Set
End Property
Public Property Minimum() As Integer
Get
Return HScrollBar1.Minimum
End Get
Set(ByVal value As Integer)
HScrollBar1.Minimum = value
End Set
End Property
Public Property Maximum() As Integer
Get
Return HScrollBar1.Maximum
End Get
Set(ByVal value As Integer)
HScrollBar1.Maximum = value
End Set
End Property
Private Sub HScrollBar1_ValueChanged(sender As Object, e As EventArgs) Handles HScrollBar1.ValueChanged
RaiseEvent ValueChanged(Me, New EventArgs)
End Sub
End Class
The Form code
Most of the code is encapsulated in Form1. This is because, as a highly graphical game, it wouldn't be appropriate to move the code to Classes. The cost would outweigh the benefits in terms of code concision...
Public Class Form1
Dim images As New Dictionary(Of Object, Bitmap)
'these 6 arrays are used in the animation effects
Dim Points1() As Point = New Point() {
New Point(388, 186),
New Point(388, 161),
New Point(368, 136),
New Point(338, 116),
New Point(298, 116),
New Point(268, 136),
New Point(248, 161),
New Point(248, 186)}
Dim Points2() As Point = New Point() {
New Point(248, 186),
New Point(248, 211),
New Point(268, 236),
New Point(298, 256),
New Point(338, 256),
New Point(368, 236),
New Point(388, 211),
New Point(388, 186)}
Dim Points3() As Point = New Point() {
New Point(248, 186),
New Point(248, 161),
New Point(228, 136),
New Point(198, 116),
New Point(158, 116),
New Point(128, 136),
New Point(108, 161),
New Point(108, 186)}
Dim Points4() As Point = New Point() {
New Point(108, 186),
New Point(108, 211),
New Point(128, 236),
New Point(158, 256),
New Point(198, 256),
New Point(228, 236),
New Point(248, 211),
New Point(248, 186)}
Dim Points5() As Point = New Point() {
New Point(388, 186),
New Point(388, 161),
New Point(368, 136),
New Point(338, 116),
New Point(298, 96),
New Point(248, 96),
New Point(198, 96),
New Point(158, 116),
New Point(128, 136),
New Point(108, 161),
New Point(108, 186)}
Dim Points6() As Point = New Point() {
New Point(108, 186),
New Point(108, 211),
New Point(128, 236),
New Point(158, 256),
New Point(198, 276),
New Point(248, 276),
New Point(298, 276),
New Point(338, 256),
New Point(368, 236),
New Point(388, 211),
New Point(388, 186)}
Dim upper() As Point = Nothing
Dim lower() As Point = Nothing
Dim loopIndex As Integer
Dim increment As Integer
Dim fixed As Integer
Dim showCards As Boolean = False
Dim r As New Random
Dim sw As New Stopwatch
Dim after() As String
Dim rgns(2) As Region
Dim showFace() As Boolean
Dim canChoose As Boolean = False
Private WithEvents tmr As New Timer With {.Interval = 40}
Private WithEvents hsb As New levelControl With {.Minimum = 25, .Maximum = 100, .Value = 40}
'clickable regions are used in allowing the card images to respond to clicking
Private Sub Form1_Load(sender As Object, e As EventArgs) Handles MyBase.Load
images.Add("Queen", My.Resources.queen)
images.Add("King", My.Resources.king)
images.Add("Ace", My.Resources.ace)
images.Add("Back", My.Resources.back)
Dim r As New Rectangle(New Point(Points4(0).X - 36, Points4(0).Y - 48), New Size(72, 96))
rgns(0) = New Region(r)
r = New Rectangle(New Point(Points2(0).X - 36, Points2(0).Y - 48), New Size(72, 96))
rgns(1) = New Region(r)
r = New Rectangle(New Point(Points1(0).X - 36, Points1(0).Y - 48), New Size(72, 96))
rgns(2) = New Region(r)
DifficultyToolStripMenuItem.DropDownItems.Add(New ToolStripControlHost(hsb))
Me.DoubleBuffered = True
Me.SetClientSizeCore(504, 396)
End Sub
'captures card clicking
Private Sub Form1_MouseDown(sender As Object, e As MouseEventArgs) Handles Me.MouseDown
If e.Button = MouseButtons.Left Then
If canChoose Then
Dim x As Integer = Array.FindIndex(rgns, Function(rgn) rgn.IsVisible(e.Location))
If x > -1 Then
showFace(x) = True
canChoose = False
Button1.Enabled = True
Me.Refresh()
End If
End If
End If
End Sub
'the animations are purely GDI+
Private Sub Form1_Paint(ByVal sender As Object, ByVal e As System.Windows.Forms.PaintEventArgs) Handles Me.Paint
If showcards Then
e.Graphics.DrawImage(If(showFace(0), images(after(0)), images("Back")), New Point(Points4(0).X - 36, Points4(0).Y - 48))
e.Graphics.DrawImage(If(showFace(1), images(after(1)), images("Back")), New Point(Points2(0).X - 36, Points2(0).Y - 48))
e.Graphics.DrawImage(If(showFace(2), images(after(2)), images("Back")), New Point(Points1(0).X - 36, Points1(0).Y - 48))
Return
End If
If upper Is Nothing Then Return
Select Case fixed
Case 0
e.Graphics.DrawImage(images("Back"), New Point(Points4(0).X - 36, Points4(0).Y - 48))
Case 1
e.Graphics.DrawImage(images("Back"), New Point(Points2(0).X - 36, Points2(0).Y - 48))
Case 2
e.Graphics.DrawImage(images("Back"), New Point(Points1(0).X - 36, Points1(0).Y - 48))
End Select
e.Graphics.DrawImage(images("Back"), New Point(upper(loopIndex).X - 36, upper(loopIndex).Y - 48))
e.Graphics.DrawImage(images("Back"), New Point(lower(loopIndex).X - 36, lower(loopIndex).Y - 48))
End Sub
Private Sub Button1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button1.Click
Button1.Enabled = False
after = New String() {"Queen", "King", "Ace"}.OrderBy(Function(s) r.NextDouble).ToArray
showFace = New Boolean() {True, True, True}
showcards = True
Me.Refresh()
Threading.Thread.Sleep(1250)
showFace = New Boolean() {False, True, True}
Me.Refresh()
Threading.Thread.Sleep(250)
showFace = New Boolean() {False, False, True}
Me.Refresh()
Threading.Thread.Sleep(250)
showFace = New Boolean() {False, False, False}
Me.Refresh()
Threading.Thread.Sleep(250)
nextMove()
sw = Stopwatch.StartNew()
tmr.Enabled = True
End Sub
Private Sub tmr_Tick(ByVal sender As Object, ByVal e As System.EventArgs) Handles tmr.Tick
showcards = False
If increment = -1 Then
If loopIndex + increment < 0 Then
If sw.Elapsed < New TimeSpan(0, 0, 10) Then
nextMove()
Else
tmr.Stop()
showcards = True
canChoose = True
End If
Else
loopIndex += increment
End If
Else
If loopIndex + increment > upper.GetUpperBound(0) Then
If sw.Elapsed < New TimeSpan(0, 0, 10) Then
nextMove()
Else
tmr.Stop()
showcards = True
canChoose = True
End If
Else
loopIndex += increment
End If
End If
Me.Refresh()
End Sub
'this method changes the variables used in the animation, allowing different moves
Private Sub nextMove()
Dim move As Integer = r.Next(0, 6)
Select Case move
Case 0
upper = Points1
lower = Points2
increment = 1
fixed = 0
loopIndex = 0
Dim temp As String = after(1)
after(1) = after(2)
after(2) = temp
Case 1
upper = Points3
lower = Points4
increment = 1
fixed = 2
loopIndex = 0
Dim temp As String = after(0)
after(0) = after(1)
after(1) = temp
Case 2
upper = Points5
lower = Points6
increment = 1
fixed = 1
loopIndex = 0
Dim temp As String = after(0)
after(0) = after(2)
after(2) = temp
Case 3
upper = Points1
lower = Points2
increment = -1
fixed = 0
loopIndex = upper.GetUpperBound(0)
Dim temp As String = after(2)
after(2) = after(1)
after(1) = temp
Case 4
upper = Points3
lower = Points4
increment = -1
fixed = 2
loopIndex = upper.GetUpperBound(0)
Dim temp As String = after(0)
after(0) = after(1)
after(1) = temp
Case 5
upper = Points5
lower = Points6
increment = -1
fixed = 1
loopIndex = upper.GetUpperBound(0)
Dim temp As String = after(0)
after(0) = after(2)
after(2) = temp
End Select
End Sub
Private Sub hsb_ValueChanged(sender As Object, e As EventArgs) Handles hsb.ValueChanged
tmr.Interval = hsb.Value
End Sub
End Class
Conclusion
This example shows how to create a lightweight GDI+ card game, with simple animations.
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 - 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