VB.Net - OOP Tangram Shapes Game
Overview
"The tangram (Chinese: 七巧板; pinyin: qīqiǎobǎn; literally: "seven boards of skill") is a dissection puzzle consisting of seven flat shapes, called tans, which are put together to form shapes." (Wikipedia: https://en.wikipedia.org/wiki/Tangram)
In this version of the game there are the regular seven 'tans' or pieces, which are comprised of three different sized right angled triangle, a square, and a parallelogram. There are five different 'target' shapes which are drawn in outline on the form as guidance. You can drag the shapes to a new location, and by doubleclicking, rotate the shape 45 degrees clockwise. Conversely, doubleclicking while holding down a Shift button on your keyboard will rotate the selected shape 45 degrees anti-clockwise. The 'target' shapes are selected via a menustrip. There is no testing to see if you've won, except your own judgement. Simply put, if you can arrange the shapes (in any order, and with any rotation) within the 'target' shape outline, you've won.
This is a fairly simple application that uses OOP techniques, GDI+ and Control Regions to create an enjoyable, usable, and quite challenging game, which requires skills and shapes perception that feature in MENSA tests.
The Piece Class
Imports System.Drawing.Drawing2D
Public Class piece
Inherits PictureBox
''' <summary>
''' API function and Constants used to detect Shift keydown
''' </summary>
''' <param name="vkey"></param>
''' <returns></returns>
Private Declare Function GetAsyncKeyState Lib "user32" (ByVal vkey As Integer) As Short
Private Const VK_LSHIFT As Integer = &HA0
Private Const VK_RSHIFT As Integer = &HA1
Dim ppts() As Byte = New Byte() {CByte(PathPointType.Line), CByte(PathPointType.Line), CByte(PathPointType.Line), CByte(PathPointType.Line), CByte(PathPointType.Line)}
Dim directions() As String = {"N", "NE", "E", "SE", "S", "SW", "W", "NW"}
''' <summary>
''' Points used for resetting shape to initial shape
''' </summary>
Dim ptA As New Point(25, 75)
Dim ptB As New Point(225, 75)
Dim ptC As New Point(225, 275)
Dim ptD As New Point(25, 275)
Dim ptE As New Point(75, 225)
Dim ptF As New Point(125, 175)
Dim ptG As New Point(175, 125)
Dim ptH As New Point(125, 275)
Dim ptI As New Point(175, 225)
Dim ptJ As New Point(225, 175)
Dim pt() As String = {"E", "S", "", "W", "", "N", "SE"}
Dim rp As New List(Of Point()) From {New Point() {ptA, ptF, ptD, ptA},
New Point() {ptB, ptF, ptA, ptB},
New Point() {ptB, ptJ, ptI, ptG, ptB},
New Point() {ptI, ptF, ptG, ptI},
New Point() {ptF, ptI, ptH, ptE, ptF},
New Point() {ptD, ptE, ptH, ptD},
New Point() {ptJ, ptC, ptH, ptJ}}
''' <summary>
''' Current region points
''' </summary>
Private _piecePoints As Point()
Private Property piecePoints() As Point()
Get
Return _piecePoints
End Get
Set(ByVal value As Point())
_piecePoints = value
End Set
End Property
''' <summary>
''' Used to detect doubleclicks
''' </summary>
Private _lastClicked As Integer
Private Property lastClicked() As Integer
Get
Return _lastClicked
End Get
Set(ByVal value As Integer)
_lastClicked = value
End Set
End Property
''' <summary>
''' Text label drawn on shape
''' </summary>
Private _pieceNumber As Integer
Private Property pieceNumber() As Integer
Get
Return _pieceNumber
End Get
Set(ByVal value As Integer)
_pieceNumber = value
End Set
End Property
''' <summary>
''' Orientation of shape
''' </summary>
Private _pointsTo As String
Private Property PointsTo() As String
Get
Return _pointsTo
End Get
Set(ByVal value As String)
_pointsTo = value
End Set
End Property
''' <summary>
''' Resets game
''' </summary>
''' <param name="pn"></param>
Public Sub initialize(ByVal pn As Integer)
Me.lastClicked = Environment.TickCount
Me.Location = New Point(25, 75)
Me.PointsTo = pt(pn - 1)
Me.pieceNumber = pn
Me.piecePoints = Array.ConvertAll(rp(pn - 1), Function(p) New Point(p.X - 25, p.Y - 75))
Me.reShape()
End Sub
''' <summary>
''' Reshapes piece and resets initial colour
''' </summary>
Public Sub reShape()
Me.DoubleBuffered = True
Me.Region = New Region(New GraphicsPath(piecePoints, ppts.Take(piecePoints.Count).ToArray))
Me.BackColor = Color.SteelBlue
Me.Invalidate()
End Sub
''' <summary>
''' Paints piece border and text label
''' </summary>
''' <param name="pe"></param>
Protected Overrides Sub OnPaint(ByVal pe As System.Windows.Forms.PaintEventArgs)
If DesignMode Then Return
pe.Graphics.DrawPolygon(New Pen(If(Me.BackColor = Color.SteelBlue, Color.White, Color.Black), 3), Me.piecePoints)
Dim textSize As SizeF = pe.Graphics.MeasureString(Me.pieceNumber.ToString, Me.Parent.Font)
If Me.pieceNumber = 3 Or Me.pieceNumber = 5 Then
Dim p As Point = measurement.findCentre(Me.piecePoints, textSize)
Dim minX As Integer = measurement.findOffsetX(Me.piecePoints)
Dim minY As Integer = measurement.findOffsetY(Me.piecePoints)
pe.Graphics.DrawString(Me.pieceNumber.ToString, Me.Parent.Font, If(Me.BackColor = Color.SteelBlue, Brushes.White, Brushes.Black), minX + p.X, minY + p.Y)
Else
Dim p As Point = measurement.findTriangleOffset(Me.PointsTo, Me.piecePoints)
p.X -= CInt(textSize.Width / 2)
p.Y -= CInt(textSize.Height / 2)
pe.Graphics.DrawString(Me.pieceNumber.ToString, Me.Parent.Font, If(Me.BackColor = Color.SteelBlue, Brushes.White, Brushes.Black), p.X, p.Y)
End If
MyBase.OnPaint(pe)
End Sub
Private Const HT_CAPTION As Integer = &H2
Private Const WM_NCLBUTTONDOWN As Integer = &HA1
''' <summary>
''' Handles rotation (doubleclicks) and dragging
''' </summary>
''' <param name="e"></param>
Protected Overrides Sub OnMouseDown(ByVal e As System.Windows.Forms.MouseEventArgs)
If Environment.TickCount - Me.lastClicked < 250 Then
Me.lastClicked = Environment.TickCount
Dim l As Point = Me.Location
Dim minX As Integer = measurement.findOffsetX(Me.piecePoints)
Dim minY As Integer = measurement.findOffsetY(Me.piecePoints)
l.Offset(New Point(minX, minY))
Dim shifting As Boolean = GetAsyncKeyState(VK_LSHIFT) < 0 Or GetAsyncKeyState(VK_RSHIFT) < 0
Me.piecePoints = rotation.RotateAll(Me.piecePoints, shifting)
minX = measurement.findOffsetX(Me.piecePoints)
minY = measurement.findOffsetY(Me.piecePoints)
Me.piecePoints = Array.ConvertAll(Me.piecePoints, Function(p) New Point(p.X + -minX, p.Y + -minY))
Me.Region = New Region(New GraphicsPath(piecePoints, ppts.Take(Me.piecePoints.Count).ToArray))
Me.Location = l
Dim index As Integer = Array.IndexOf(directions, Me.PointsTo)
If shifting Then
If index <= 0 Then
Me.PointsTo = directions.Last
Else
Me.PointsTo = directions(index - 1)
End If
Else
Me.PointsTo = directions((index + 1) Mod directions.Length)
End If
Me.Invalidate()
Else
Me.lastClicked = Environment.TickCount
End If
For Each box As PictureBox In Me.FindForm.Controls.OfType(Of piece)()
If Not box Is Me Then box.BackColor = Color.SteelBlue
box.Invalidate()
Next
Me.BackColor = Color.FromArgb(192, 255, 192)
If e.Button = Windows.Forms.MouseButtons.Left Then
For Each box As PictureBox In Me.FindForm.Controls.OfType(Of piece)()
box.SuspendLayout()
Next
Me.BringToFront()
Me.Capture = False
Me.WndProc(Message.Create(Me.Handle, WM_NCLBUTTONDOWN, CType(HT_CAPTION, IntPtr), IntPtr.Zero))
For Each box As PictureBox In Me.FindForm.Controls.OfType(Of piece)()
box.ResumeLayout()
Next
End If
MyBase.OnMouseDown(e)
End Sub
End Class
Conclusion
This is another example that shows VB.Net and GDI+ are a good choice of technologies when writing this sort of desktop game...
Other Resources
C# TechNet version
Download here (VB.NET and C#)
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#
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