This sample code demonstrates implementing a Solitaire game using Visual Basic. This code does not necessarily work; it is meant to highlight how to use the various Solitaire Pack interfaces.

The game presented here is Aces Up. The goal of the game is to get four Aces (which are high) remaining. Cards are first put in the Stock. Then, four are turned up at a time onto piles. Only the top cards of the pile can be played. A card can be played to the Foundation when a card of the same suit but higher rank is also on top of some pile. Cards can be moved into empty spaces. Four more cards are then turned up, and so on.

The excerpts presented are from the implementation of a Visual Basic class. The game class must implement the ISolpackGame interface.

This class contains member variables that store the Engine, the deck, and piles. Also, GameData objects are used to cache the top card of each pile, instead of having to manually get the card each time. The final variable is used to keep track of the pile from which a drag operation started.

Option Explicit
Implements ISolpackGame

' member variables
Dim m_pApp As ISolpackApp                 ' the solitaire pack engine
Dim m_pDeck As ISolpackPile               ' our deck of cards
Dim m_pStock As ISolpackPile              ' the stock
Dim m_aPiles(3) As ISolpackPile           ' the four piles
Dim m_pFoundation As ISolpackPile         ' the foundation pile
Dim m_pWastePile As ISolpackPile          ' the waste pile
Dim m_aTopOfPile(3) As ISolpackGameData   ' cache the card at the top of each pile
Dim m_pSourcePile As ISolpackPile         ' while dragging, the cards' source pile

This method would return an object that implements the ISolpackGameInfo interface, from which the game title, rules, and difficulty could be obtained. It is not implemented here.

' ISolpackGame::Info property
Private Property Get ISolpackGame_Info() As SolpackLib.ISolpackGameInfo

    ISolpackGame_Info = Nothing

End Property

This method caches the engine object, creates the deck, creates several piles, and sets several pile comments. Finally, it calls RecalcLayout to position the pile objects.

' ISolpackGame::Initialize method
Private Sub ISolpackGame_Initialize(ByVal pApp As SolpackLib.ISolpackApp)
    
    Set m_pApp = pApp

    ' create a deck
    Set m_pDeck = m_pApp.CreatePile(PILE_DECK)

    ' create the piles
    Dim i As Integer
    For i = 0 To 3
        Set m_aPiles(i) = m_pApp.CreatePile(PILE_TABLEAUDOWN)
        Set m_aTopOfPile(i) = m_pApp.CreateGameData()
    Next i
    
    ' Create and set up the stock pile
    Set m_pStock = m_pApp.CreatePile(PILE_STACK)
    m_pStock.ShowNumCardsTooltip = True
    m_pStock.CommentTooltip = "Stock." & Chr(13) & _
        "Deal an additional row of cards."
    
    ' Create and set up the foundation pile
    Set m_pFoundation = pApp.CreatePile(PILE_STACK)
    m_pFoundation.BaseImage = BASE_FOUNDATION
    m_pFoundation.ShowNumCardsTooltip = True
    m_pFoundation.CommentTooltip = "Foundation." & Chr(13) & _
        "Get 48 cards here to win."
    
    ' Create and set up the waste pile
    Set m_pWastePile = pApp.CreatePile(PILE_STACK)
    m_pWastePile.CommentTooltip = "Waste Pile." & Chr(13) & _
        "You may put any cards here at any time, but may not remove them."
    
    RecalcLayout     ' position the piles

End Sub

This method releases all created objects by setting them equal to Nothing.

' ISolpackGame::Uninitialize method
Private Sub ISolpackGame_Uninitialize()

    ' Release pile and data objects
    Dim i As Integer
    For i = 0 To 3
        Set m_aPiles(i) = Nothing
        Set m_aTopOfPile(i) = Nothing
    Next i
    Set m_pSourcePile = Nothing
    Set m_pStock = Nothing
    Set m_pWastePile = Nothing
    Set m_pFoundation = Nothing
    Set m_pDeck = Nothing
    Set m_pApp = Nothing

End Sub

This method shuffles the deck, and creates a fragment to transfer the cards from the deck to the Stock pile.

' ISolpackGame::Deal method
Private Sub ISolpackGame_Deal()
   
    ' Shuffle the deck and set the initial score
    m_pDeck.Shuffle
    m_pApp.Score = 4
    
    ' Use a fragment to transfer all cards in the deck to the stock
    Dim pFrag As ISolpackFragment
    Set pFrag = m_pApp.Fragment

    pFrag.AddToFragment pDeck
    pFrag.MoveToPile m_pStock, False, False   ' no animation
    Set pFrag = Nothing    ' Release the fragment

End Sub

This method goes through the cards at the top of each pile, and autoplays them if possible. Whenever a card is autoplayed, it will start over at the first pile. When all top-level cards cannot be autoplayed, the method finishes. The return value is True if any card was played, else False.

' ISolpackGame::AutoPlay method
Private Function ISolpackGame_AutoPlay() As Boolean

    ISolpackGame_AutoPlay = False
    Dim i As Integer
    i = 0

    ' Go through the four piles. If we autoplay, start over at first pile
    While i < 4
        If InternalAutoPlayCard(m_aTopOfPile(i).Data) Then
            i = 0
            ISolpackGame_AutoPlay = True
        Else
            i = i + 1
        End If
    Wend

End Function

This method tries autoplaying the individual card specified.

' ISolpackGame::AutoPlayCard method
Private Function ISolpackGame_AutoPlayCard(ByVal pCard As SolpackLib.ISolpackCard)
                     As Boolean

    ISolpackGame_AutoPlayCard = InternalAutoPlayCard(pCard)

End Function

This method does not do anything. If you do register commands, you should check the lID parameter and handle the command as appropriate.

' ISolpackGame::HandleCommand method
Private Sub ISolpackGame_HandleCommand(ByVal lID As Long)

    ' We don't register any commands.

End Sub

This method is called when any pile is clicked. The only pile we care about is the Stock; when it is clicked, we move four cards from the stock to the four piles. The CanDrag properties of the former "top of pile" cards, if existant, are set to False, and the new cards are set as the top cards. The cards are animated and flipped over when the animation finishes.

' ISolpackGame::PileClicked method
Private Sub ISolpackGame_PileClicked(ByVal pPile As SolpackLib.ISolpackPile,
                                     ByVal pCard As SolpackLib.ISolpackCard)

    ' Only the stock is clickable.
    If Not pPile Is m_pStock Or m_pStock.NumCards = 0 Then Return

    ' Get the number of cards in the stock.
    Dim cCards as Integer
    cCards = m_pStock.NumCards

    ' Deal four cards from the stock onto the piles.
    Dim i as Integer
    For i = 0 To 4
        If Not m_aTopOfPile(i).Data Is Nothing Then
            m_aTopOfPile(i).Data.CanDrag = False
        End If

        Dim pCard as SolpackLib.ISolpackCard
        pCard = m_pStock.GetCard(cCards - (i + 1))
        pCard.CanDrag = True

        ' Create the fragment for moving.
        Dim pFrag As SolpackLib.ISolpackFragment
        pFrag = m_pApp.CreateFragment(m_pStock)
        pFrag.AddToFragment pCard
        m_aTopOfPile(i).Data = pCard
        pFrag.MoveToPile m_aPiles(i), True, True    ' Flip cards at end of animation
    Next i

End Sub

When the user starts to drag a card, this method is called. If the card is at the top of one of the piles, we add it to the fragment.

' ISolpackGame::SetupFragment method
Private Sub ISolpackGame_SetupFragment(ByVal pPileSrc As SolpackLib.ISolpackPile,
                                       ByVal pCardSrc As SolpackLib.ISolpackCard,
                                       ByVal pFrag As SolpackLib.ISolpackFragment)

    Dim i as Integer
    For i = 0 To 4
        If pCardSrc Is m_aTopOfPile(i).Data Then  ' Card is draggable
            Set m_pSourcePile = pPileSrc
            pFrag.AddToFragment pCardSrc
            Return
        End If
    Next i

End Sub

When the user drops a card over a pile, this method is called. First we ensure we have a valid fragment and that the target pile is not the Stock. Then, we find the index of the source pile and the destination pile (if it is one of the four tableau piles). If the destination pile is the waste pile, the card is moved there. If it is the foundation, we check to see if the card is playable, and move it to the foundation if it is. If the destination is another pile, which is empty, we move the card to it. "Top of pile" objects are updated as necessary.

' ISolpackGame::DropFragment method
Private Function ISolpackGame_DropFragment(ByVal pFrag As SolpackLib.ISolpackFragment,
                                           ByVal pDest As SolpackLib.ISolpackPile)
                                           As Boolean

    Dim bReturn As Boolean
    bReturn = False

    ' Ensure valid fragment and target
    If pFrag.NumCards <> 1 Or pDest Is m_pStock Then Return

    ' Get the card that is being dragged
    Dim pCard As SolpackLib.ISolpackCard
    Set pCard = pFrag.GetCard(0)

    Dim i As Integer
    Dim iSrc As Integer
    Dim iDest As Integer
    iSrc = -1
    iDest = -1

    ' Find the indices of the source and destination piles
    For i = 0 To 4
        If m_pSourcePile Is m_aPiles(i) Then iSrc = i
        If pDest Is m_aPiles(i) Then iDest = i
    Next i

    ' Move to waste pile?
    If pDest Is m_pWastePile Then
        pCard.CanDrag = False
        pFrag.MoveToPile m_pWastePile, True, False
        bReturn = True

    ' Move to foundation, if valid
    ElseIf pDest Is m_pFoundation Then
        If IsCardPlayable(iSrc) Then
            pFrag.MoveToPile m_pFoundation, True, False
            ScoreCard pCard
            bReturn = True
        End If

    ' Move the card to the pile, if empty
    ElseIf iDest <> -1
        If m_aPiles(iDest).NumCards = 0 Then
            pFrag.MoveToPile pDest, True, False
            m_aTopOfPile(iDest).Data = pCard
            bReturn = True
        End If
    End If

    ' If we moved the card, then update the source pile
    If bReturn Then
        Set m_pSourcePile = Nothing
        If m_aPiles(iSrc).NumCards > 0
            Dim pNewTop As SolpackLib.ISolpackCard
            Set pNewTop = m_aPiles(iSrc).GetCard(m_aPiles(iSrc).NumCards - 1)
            pNewTop.CanDrag = True
            m_aTopOfPile(iSrc).Data = pNewTop
        End If
    End If

    ISolpackGame_DropFragment = bReturn

End Function

This method releases the cached source pile object by setting it to Nothing.

' ISolpackGame::CancelMove method
Private Sub ISolpackGame_CancelMove()

    Set m_pSourcePile = Nothing

End Sub

This method lays out the pile objects, either when the game is initialized or when window or card metrics change.

' ISolpackGame::RecalcLayout method
Private Sub ISolpackGame_RecalcLayout()

    ' Position the piles
    Dim i As Integer
    For i = 0 To 3
        m_aPiles(i).X = (((m_pApp.CardWidth + m_pApp.SpacingX) * (i + 1)) + _
            (1.5 * m_pApp.SpacingX))
        m_aPiles(i).Y = m_pApp.SpacingY
    Next i

    ' Position the stock pile
    m_pStock.X = m_pApp.SpacingX
    m_pStock.Y = m_pApp.SpacingY

    ' Position the foundation pile
    m_pFoundation.X = (m_pApp.CardWidth * 5) + (m_pApp.SpacingX * 7)
    m_pFoundation.Y = m_pApp.SpacingY
    
    ' Position the waste pile
    m_pWastePile.X = m_pApp.SpacingX
    m_pWastePile.Y = m_pApp.CardHeight + (2.5 * m_pApp.SpacingY)

End Sub

This function determines whether a card can be played to the foundation. It looks at all other "top of pile" cards, and if one of them has the same suit as this card but a higher rank, this card can be played.

' IsCardPlayable helper function
Private Function IsCardPlayable(iPileIndex As Integer) As Boolean

    Dim bCanMove As Boolean
    bCanMove = False
    
    ' Get the top of the given pile
    Dim pCard As ISolpackCard
    Set pCard = m_aTopOfPile(iPileIndex).Data
    
    Dim pTop As ISolpackCard
    Dim j As Integer
    
    ' Go through each other pile
    For j = 0 To 4
        If Not bCanMove Then
            If Not (j = iPileIndex) Then
                Set pTop = m_aTopOfPile(j).Data

                ' Cards must be same suit
                If pTop.Suit = pCard.Suit Then
                    ' Given card must be less in rank than some other top card
                    If ((pCard.Rank < pTop.Rank) Or (pTop.Rank = RANK_ACE))
                        And (Not (pCard.Rank = RANK_ACE)) Then
                        IsCardPlayable = True
                        Return
                    End If
                End If
                Set pTop = Nothing
            End If
        End If
    Next j

    IsCardPlayable = False

End Function

This function plays the card to a foundation, if possible. It is used by the AutoPlay and AutoPlayCard methods.

' InternalAutoPlayCard helper function
Private Function InternalAutoPlayCard(ByVal pCard As SolpackLib.ISolpackCard)
                    As Boolean

    InternalAutoPlayCard = False

    If pCard Is Nothing Then
        Return
    End If

    Dim j As Integer
    For j = 0 To 4
        If m_aTopOfPile(j).Data Is pCard Then
            ' The card is the top of a pile, so test it
            If IsCardPlayable(j) Then
               Dim pFrag As ISolpackFragment
               pFrag = m_pApp.CreateFragment(m_aPiles(j)) 
               pFrag.AddToFragment pCard
               pFrag.MoveToPile m_pFoundation, True, False
               ScoreCard pCard

               ' Update the new "top of pile" data
               Dim pNewTop As ISolpackCard
               If m_aPiles(j).NumCards = 0 Then
                  Set m_aTopOfPile(j).Data = Nothing
               Else
                  Set m_aTopOfPile(j) = m_aPiles(j).GetCard(m_aPiles(j).NumCards - 1)
                  m_aTopOfPile(j).Data.CanDrag = True
               End If

               InternalAutoPlayCard = True
            End If
            Return
        End If
    Next j
    
End Function

This sub is called after a card has been moved to the foundation (either by autoplay or by drop). It sets the specified card's CanDrag property to false, increments the score, and checks whether the game is now won.

' ScoreCard helper sub
Private Sub ScoreCard(ByVal pCard As SolpackLib.ISolpackCard)

    If pCard Is Nothing Then Return

    pCard.CanDrag = False
    m_pApp.Score = m_pApp.Score + 1
    If m_pApp.Score = 52 Then m_pApp.GameWon

End Sub