Introduction
There are many good articles on the net on how to use the Cards dynamic link library, so I thought it would be fun to make my favorite one player card game, FreeCell.
Background
I really like FreeCell. In 1992, Marc L. Allen programmed and published one of the better FreeCell games available for Windows. It still works today on 32 bit Windows XP and Vista, but it is a 16 bit application, so it can't run on Vista or XP 64. I really liked the interface he used, so I decided to code a modern version of his original FreeCell Game.
Using the Code
This project uses the Cards.dll library to draw the playing cards. There are many good articles on the net on how to use the Cards dynamic link library. If you are not familiar with the cards library, I recommend you read Matt Pietrek's article on the subject: http://catch22.net/tuts/cards.
Cards.dll exposes four functions and one sub routine. They are:
cdtInit
: This function initializes the cards library, and must be called first.
Private Declare Function cdtInit Lib "cards.dll" (ByRef width As Integer, _
ByRef height As Integer) As Boolean
This function takes two arguments: the width and height of the card. These are integer variables supplied by the calling application, and are used to record the default values used by the Cards Library for card width and height. The default values are 71 pixels for card width, and 96 pixels for card height. These values are important if you are going to change the default sizes, because the ratio of 71 by 96 should be maintained, so that the card images are not distorted. But most applications use the default values, which work fine in most cases. If you are using the default values for your cards and don’t need the size, you can simply use zeros in place of the Width
and Height
variables.
cdtTerm
: This sub routine is the library’s destructor method, and it frees the library from memory if no other applications are using it.
Declare Sub cdtTerm Lib "cards.dll" ()
Call this method when your application exits, or when you are finished drawing any cards.
cdtDraw
: This function draws the cards using their default size.
Declare Function cdtDraw Lib "cards.dll" (ByVal hDC As IntPtr, ByVal x As Integer, _
ByVal y As Integer, ByVal Card As Integer, _
ByVal Type As Integer, ByVal clr As Integer) As Integer
This function takes the following arguments:
hDC
: The Handle for the object that the card image will be drawn on.X
: The x-axis origin for the card image.Y
: The y-axis origin for the card image.Card
: The card value. Either the face value of the card, or the value for the pattern to draw if drawing the card back.Type
: Specifies to draw the face, back, or inverted face of the card. Set this value to zero to draw the card face, and one to draw the card back.Clr
: Sets the background color for the CrossHatch card back. All other card backs and fronts are bitmaps, so setting this has no effect for any other card back. Leave this value at zero, unless you are drawing a card back with the CrossHatch pattern.
cdtDrawExt
: Same as cdtDraw
except this function allows you to specify the height and width of the card being drawn.
Declare Function cdtDrawExt Lib "cards.dll" (ByVal hdc As IntPtr, ByVal x As Integer, _
ByVal y As Integer, ByVal dx As Integer, ByVal dy As Integer, _
ByVal card As Integer, ByVal type As Integer, _
ByVal color As Long) As Boolean
cdtAnimate
: Animates the card back. Call this function in a loop with iState
initially set to zero, and loop until the function returns zero. I personally have never used this function.
Declare Function cdtAnimate Lib "cards.dll" (ByVal hDC As IntPtr, _
ByVal ecbCardBack As Integer, ByVal x As Integer, _
ByVal y As Integer, ByVal iState As Integer) As Integer
Card values are based on a standard 52 card deck, with no Jokers. Card values are derived from their suit and face value.
The formula for determining a card value is: FaceValue * 4 + SuitValue, or 4F + Suit.
The face and suit value enumerations are as follows:
Public Enum Suit As Byte
CLUBS = 0
DIAMONDS = 1
HEARTS = 2
SPADES = 3
End Enum
Public Enum Face As Byte
Ace = 0
Two = 1
Three = 2
Four = 3
Five = 4
Six = 5
Seven = 6
Eight = 7
Nine = 8
Ten = 9
Jack = 10
Queen = 11
King = 12
End Enum
Examples using 4F + Suit = Card Value:
- The Ace of Spades would be 4 * 0 + 3 = a Card Value of 3.
- The Eight of Clubs would be 4 * 7 + 0 = a Card Value of 28.
Here are all of the card values:
Ace| 2 | 3 | 4 | 5 | 6 | 7 | 8 | 9 | 10 |Jack|Queen|King
In my card class, the card is initialized with its card value, and this value never changes for the lifetime of that card. This makes drawing the card face really easy.
Public Class Card : Inherits Control
Public CardValue As Byte
Public OldPoint As Point
Sub New(ByVal cardvalue As Byte)
Me.Size = New Size(CardWidth, CardHeight)
Me.CardValue = cardvalue
End Sub
Private Sub PaintCard(ByVal sender As Object, ByVal e As PaintEventArgs) _
Handles Me.Paint
cdtDraw(e.Graphics.GetHdc, 0, 0, DirectCast(sender, Card).CardValue, 0, 0)
End Sub
End Class
The Cards library does not have any methods to sort or compare the cards. You have to write your own methods, based on the card game. The methods shown below are for FreeCell:
Private Function CardFaceValue(ByVal CardValue As Byte, ByVal suite As Suit) As Face
Return CType((CardValue - suite) / 4, Face)
End Function
Public ReadOnly Property FaceValue(ByVal CardValue As Byte) As Face
Get
Return CType(CardFaceValue(CardValue, SuitValue(CardValue)), Face)
End Get
End Property
Public ReadOnly Property NextFaceValue(ByVal CardValue As Byte) As Byte
Get
Dim f As Face = FaceValue(CardValue)
Dim s As Suit = SuitValue(CardValue)
If f < Face.King Then
Return CByte(s + (f + 1) * 4)
Else
Return CByte(s + Face.Ace * 4)
End If
End Get
End Property
Public ReadOnly Property PrevCardValue(ByVal CardValue As Byte) As Byte
Get
Dim f As Face = FaceValue(CardValue)
Dim s As Suit = SuitValue(CardValue)
If CardValue > 3 Then
Return CByte(s + (f - 1) * 4)
Else
Return CByte(s + Face.King * 4)
End If
End Get
End Property
Public ReadOnly Property OppositeSuit(ByVal CardValue As Byte) As SuitColor
Get
Select Case SuitValue(CardValue)
Case Suit.CLUBS, Suit.SPADES
Return SuitColor.Red
Case Suit.DIAMONDS, Suit.HEARTS
Return SuitColor.Black
End Select
End Get
End Property
Public Function PrevOppositeSuite(ByVal CardValue As Byte) As Byte()
Dim s As Suit = SuitValue(CardValue)
Dim OppCards(1) As Byte
Dim f As Face = Me.CardFaceValue(CardValue, s)
If f = Face.Ace Then
f = Face.King
Else
f = CType(f - 1, Face)
End If
Select Case s
Case Suit.CLUBS, Suit.SPADES
OppCards(0) = CByte(f * 4 + Suit.DIAMONDS)
OppCards(1) = CByte(f * 4 + Suit.HEARTS)
Case Suit.DIAMONDS, Suit.HEARTS
OppCards(0) = CByte(f * 4 + Suit.SPADES)
OppCards(1) = CByte(f * 4 + Suit.CLUBS)
End Select
Return OppCards
End Function
Public Function NextOppositeSuite(ByVal CardValue As Byte) As Byte()
Dim s As Suit = SuitValue(CardValue)
Dim OppCards(1) As Byte
Dim f As Face = Me.CardFaceValue(CardValue, s)
If f = Face.King Then
f = Face.Ace
Else
f = CType(f + 1, Face)
End If
Select Case s
Case Suit.CLUBS, Suit.SPADES
OppCards(0) = CByte(f * 4 + Suit.DIAMONDS)
OppCards(1) = CByte(f * 4 + Suit.HEARTS)
Case Suit.DIAMONDS, Suit.HEARTS
OppCards(0) = CByte(f * 4 + Suit.SPADES)
OppCards(1) = CByte(f * 4 + Suit.CLUBS)
End Select
Return OppCards
End Function
Public Function SuitValue(ByVal CardValue As Byte) As Suit
Select Case CardValue
Case 0, 4, 8, 12, 16, 20, 24, 28, 32, 36, 40, 44, 48
Return Suit.CLUBS
Case 1, 5, 9, 13, 17, 21, 25, 29, 33, 37, 41, 45, 49
Return Suit.DIAMONDS
Case 2, 6, 10, 14, 18, 22, 26, 30, 34, 38, 42, 46, 50
Return Suit.HEARTS
Case Else
Return Suit.SPADES
End Select
End Function
The Freecell game uses the MouseDown
, MouseMove
, and MouseUp
events to move the cards. I also use double-click for when the cards can clear to the ace home cells.
One problem with detecting mouse down and mouse up and also double-click is, when the user double-clicks, you have to be able to disregard the mouse down and mouse up events. What I did was I made a doubleclick boolean and sets it to true on the mouse down event, and sets it to false during mouse move. In my mouse up event, the code exits if doubleclick is true. That way, when the user double-clicks but the card did not move, the code in mouse up ignores the call.
Sub Card_MouseDown(ByVal sender As Object, ByVal e As MouseEventArgs)
If e.Clicks = 1 AndAlso e.Button = Windows.Forms.MouseButtons.Left Then
OldMousept = e.Location
DblClick = True
Dim c As Card = DirectCast(sender, Card)
c.BringToFront()
Xpos = Control.MousePosition.X - c.Left
Ypos = Control.MousePosition.Y - c.Top
End If
End Sub
Sub Card_MouseMove(ByVal sender As Object, ByVal e As MouseEventArgs)
If e.Clicks = 0 AndAlso e.Button = Windows.Forms.MouseButtons.Left AndAlso _
e.Location <> OldMousept Then
DblClick = False
DirectCast(sender, Card).Location = _
New Point(Control.MousePosition.X - Xpos, _
Control.MousePosition.Y - Ypos)
End If
End Sub
Sub Card_MouseUp(ByVal sender As Object, _
ByVal e As System.Windows.Forms.MouseEventArgs)
If Not DblClick AndAlso e.Button = Windows.Forms.MouseButtons.Left Then
Dim c As Card = DirectCast(sender, Card)
Dim idx As Integer
Select Case c.Left
Case 77 To 150
Select Case c.Top
Case 138 To 238
TryDockAce(c, 0, True)
Case 247 To 347
TryDockAce(c, 1, True)
Case 356 To 456
TryDockAce(c, 2, True)
Case 469 To 565
TryDockAce(c, 3, True)
Case Else
c.Location = c.OldPoint
End Select
Case 157 To 233
idx = Columns(0).Count - 1
Select Case True
Case idx > -1
If Columns(0)(idx) Is c Then
c.Location = c.OldPoint
ElseIf c.Top >= Columns(0)(idx).Top - 50 AndAlso _
c.Top <= Columns(0)(idx).Top + 70 Then
TryMoveToColumn(c, idx, 0, False)
Else
c.Location = c.OldPoint
End If
Case c.Top >= Rows(0) - 50 AndAlso c.Top <= Rows(0) + 70
MoveToEmptyCol(c, 0, False)
Case Else
c.Location = c.OldPoint
End Select
Case 240 To 316
idx = Columns(1).Count - 1
Select Case True
Case idx > -1
If Columns(1)(idx) Is c Then
c.Location = c.OldPoint
ElseIf c.Top >= Columns(1)(idx).Top - 50 AndAlso _
c.Top <= Columns(1)(idx).Top + 70 Then
TryMoveToColumn(c, idx, 1, False)
Else
c.Location = c.OldPoint
End If
Case c.Top >= Rows(0) - 50 AndAlso c.Top <= Rows(0) + 70
MoveToEmptyCol(c, 1, False)
Case Else
c.Location = c.OldPoint
End Select
Case 323 To 399
Select Case True
Case c.Top >= 570 AndAlso c.Top <= 681
TryDockFC(c, 0)
Case Columns(2).Count > 0
idx = Columns(2).Count - 1
If Columns(2)(idx) Is c Then
c.Location = c.OldPoint
ElseIf c.Top >= Columns(2)(idx).Top - 50 AndAlso _
c.Top <= Columns(2)(idx).Top + 70 Then
TryMoveToColumn(c, idx, 2, False)
Else
c.Location = c.OldPoint
End If
Case c.Top >= Rows(0) - 50 AndAlso c.Top <= Rows(0) + 70
MoveToEmptyCol(c, 2, False)
Case Else
c.Location = c.OldPoint
End Select
Case 406 To 482
Select Case True
Case c.Top >= 570 AndAlso c.Top <= 681
TryDockFC(c, 1)
Case Columns(3).Count > 0
idx = Columns(3).Count - 1
If Columns(3)(idx) Is c Then
c.Location = c.OldPoint
ElseIf c.Top >= Columns(3)(idx).Top - 50 AndAlso _
c.Top <= Columns(3)(idx).Top + 70 Then
TryMoveToColumn(c, idx, 3, False)
Else
c.Location = c.OldPoint
End If
Case c.Top >= Rows(0) - 50 AndAlso c.Top <= Rows(0) + 70
MoveToEmptyCol(c, 3, False)
Case Else
c.Location = c.OldPoint
End Select
Case 489 To 565
Select Case True
Case c.Top >= 570 AndAlso c.Top <= 681
TryDockFC(c, 2)
Case Columns(4).Count > 0
idx = Columns(4).Count - 1
If Columns(4)(idx) Is c Then
c.Location = c.OldPoint
ElseIf c.Top >= Columns(4)(idx).Top - 50 AndAlso _
c.Top <= Columns(4)(idx).Top + 70 Then
TryMoveToColumn(c, idx, 4, False)
Else
c.Location = c.OldPoint
End If
Case c.Top >= Rows(0) - 50 AndAlso c.Top <= Rows(0) + 70
MoveToEmptyCol(c, 4, False)
Case Else
c.Location = c.OldPoint
End Select
Case 572 To 648
Select Case True
Case c.Top >= 570 AndAlso c.Top <= 681
TryDockFC(c, 3)
Case Columns(5).Count > 0
idx = Columns(5).Count - 1
If Columns(5)(idx) Is c Then
c.Location = c.OldPoint
ElseIf c.Top >= Columns(5)(idx).Top - 50 AndAlso _
c.Top <= Columns(5)(idx).Top + 70 Then
TryMoveToColumn(c, idx, 5, False)
Else
c.Location = c.OldPoint
End If
Case c.Top >= Rows(0) - 50 AndAlso c.Top <= Rows(0) + 70
MoveToEmptyCol(c, 5, False)
Case Else
c.Location = c.OldPoint
End Select
Case 649 To 731
idx = Columns(6).Count - 1
Select Case True
Case idx > -1
If Columns(6)(idx) Is c Then
c.Location = c.OldPoint
ElseIf c.Top >= Columns(6)(idx).Top - 50 AndAlso _
c.Top <= Columns(6)(idx).Top + 70 Then
TryMoveToColumn(c, idx, 6, False)
Else
c.Location = c.OldPoint
End If
Case c.Top >= Rows(0) - 50 AndAlso c.Top <= Rows(0) + 70
Me.MoveToEmptyCol(c, 6, False)
Case Else
c.Location = c.OldPoint
End Select
Case 732 To 814
idx = Columns(7).Count - 1
Select Case True
Case idx > -1
If Columns(7)(idx) Is c Then
c.Location = c.OldPoint
ElseIf c.Top >= Columns(7)(idx).Top - 50 AndAlso _
c.Top <= Columns(7)(idx).Top + 70 Then
TryMoveToColumn(c, idx, 7, False)
Else
c.Location = c.OldPoint
End If
Case c.Top >= Rows(0) - 50 AndAlso c.Top <= Rows(0) + 70
Me.MoveToEmptyCol(c, 7, False)
Case Else
c.Location = c.OldPoint
End Select
Case Else
c.Location = c.OldPoint
End Select
End If
End Sub
Once all cards have been cleared to the Ace Home Cells, in FreeCell, the game has been won. In this game, a thread re-initializes the cards and spreads them out, using a thread-safe invoke method to move each card. Cards are spread out at a random distance. Sometimes they are spread out just enough to see each card. Sometimes they are spread way out, like in the picture below:
Most Freecell games have saved games, or saved decks that can be selected and played. Microsoft FreeCell for Windows XP has 100,000 selectable games. I decided to store 100,000 games in an embedded binary file for selecting games. The simplest way to do this for Freecell is to store a pattern of 52 bytes in a particular order that it will be dealt out in, for the game. With no padding between the bytes, my 100,000 games took up over 5 MB, which is why my application is over 5 MB. I tried compressing the file, and it was still over 3 MB. Microsoft manages to store the same 100,000 games, and their FreeCell app is only 55 kilobytes. If anyone knows how they manage this, I would like to know.
Updated: Thanks, MojoFlys, for pointing out that when getting a set of cards for a new game, instead of loading a set of bytes, you can simply use the selected game number as a seed for an instance of a random class, and generate the cards that way. Then, you can make a specific card deal based on the game number selected, without having to store anything.
I modified the project, and here is the new method for the user selected game. GameIndex
is the selected game, an Integer
between 1 and 100,000. Much easier than having to store 100,000 games!
Dim r As New Random(GameIndex)
Dim Cards(51) As Byte
Dim st As New Generic.Stack(Of Byte)
Do
For b As Byte = 0 To 51
b = CType(r.Next(0, 52), Byte)
If Not st.Contains(b) Then
st.Push(b)
End If
Next b
Loop Until st.Count = 52
Updated: I found a bug in the code that records which cards are sorted, and can be moved as a column. It was in the SetSorted
subroutine. Here is the updated code. The project download and executable download have both been updated. Note that in the old subroutine, in the For Next
loop, if the next opposite card did not match, the Else
statement was missing, and it would not exit the sub. Instead, it would keep looping, so you could have two sets of sorted cards in the same column, and move events would be added to cards that should remain un-moveable.
Sub SetSorted(ByVal Col As Byte)
Dim idx As Integer
For idx = 0 To Columns(Col).Count - 1
RemoveSortedEvents(Columns(Col)(idx))
Next idx
idx = Columns(Col).Count - 1
If idx > 0 Then
Dim Cards As Byte()
For i As Integer = idx To 1 Step -1
Cards = pc.NextOppositeSuite(Columns(Col)(i).CardValue)
If Cards(0) = Columns(Col)(i - 1).CardValue OrElse _
Cards(1) = Columns(Col)(i - 1).CardValue Then
AddSortedEvents(Columns(Col)(i - 1))
Else
Exit Sub
End If
Next i
End If
End Sub
This project was really a lot of fun to code, and it was one of those fun projects you have a hard time putting down. I started coding it over one weekend, and one weekend of coding for fun turned into three :).
Please note that to run this application in Windows Vista, you will need to copy Cards.dll to the same folder that the exe file is in, or you can also run RegSvr32 and register cards.dll in Vista.
Freeeware: Please feel free to use or modify any of the code in this project, but do not use it for any commercial product.
Disclaimer: I am not responsible for any damage to any computer equipment, or for any data loss that might occur while using any of the code posted in this article. Use this code at your own risk.