Click here to Skip to main content
15,944,136 members
Articles / Desktop Programming / WPF

Redesigned German Cards Game "Schafkopf"

Rate me:
Please Sign up or sign in to vote.
5.00/5 (6 votes)
16 Feb 2024CPOL10 min read 18.1K   325   22   5
This article and the demo are about getting started using my Schafkopf_OOP VB.NET project.
There are many CodeProject articles about other card games, but nothing with Schafkopf. So I started to create this article. The first program versions had some unstructured and not reusable code parts and were withdrawn later. Some weeks ago, I decided to make it better and to redesign this project.

Introduction 

This article and the demo are about getting started using my Schafkopf_OOP VB.NET project and Schafkopf_Cs C# project.

Background

There are many CodeProject articles about other card games, but nothing with Schafkopf. So I started to create this article.

Using the Code

Here is a Quick Overview

MainWindow Concept and Code

When you start the program, the main window shows a complete deck of cards as a card fan and renders it in a circular panel (based on the above mentioned CodeProject article, Power of Templates in Control Development Within Windows Presentation Foundation including this credit: "I took this panel from the color swatch sample that ships with Microsoft Expression Blend“).

On top of the window, there are some menu items – click on 1. New Game please, then you should see something like that:

Image 1

MainWindow has the following controls:

  • A Grid with
    • a StackPanel called MyPanel
    • a WrapPanel (on top) with the menu items
    • HistoryTextBox for Trick History
    • Panels for the cards within the StackPanel called MyPanel
    • Panel0 with ListBox0 on top for player0 = North
    • Panel2 with ListBox2 on bottom for player2 = South
    • Panel1 with ListBox1 on right side for player1 = East
    • Panel3 with ListBox3 on left side for player3 = West
    • Panel4 with ListBox4 is used as TrickHistory (for already played cards)
    • DockPanel CenterPanel

Card Resources and Definitions

The files in folder Resources are taken from [2].

I have changed some things as follows:

  • Jacks         => Unter => Under (or Sergeant)
  • Queens     => Ober => Over (or Officer)
  • Diamonds => Shells or Ring
  • Clubs        => Acorn

To keep things easy, I left Spades (which could become "Grass“) as it was.

Class Schafkopf is based on [1].

I have changed the cards deck from 52 to 32 and adjusted the card values and colors as described above.

Putting Things Together - WPF Concept and Code

Shuffle and Distribute Cards

Function CardsDeck.Shuffle is part of the framework [4].

Classes PlayingCard and CircularPanel are taken from Reference [2].

I have added the following properties:

  • Public Property CardSymbol As String
  • Public Property CardShortName As String
  • Public Property IsCallAce As Boolean
  • Public Property IsAlreadyPlayed As Boolean
  • Private Shared CardOwnerProperty As DependencyProperty = DependencyProperty.Register("CardOwner", GetType(CardOwner), GetType(PlayingCard), New PropertyMetadata(CardOwner.North))

. . .

When you click on 1. New Game, the ShuffleArray method is started.

After that, the shuffled cards are distributed to the four ListBoxes / CardPanels. This happens via data binding. Sorting HandCards is possible with the framework.

VB.NET
Public Sub NewGame()

        processing = True
        Me.CircDeck.Children.Clear()
        CardsDeck.Reset()
        Hand0.Reset()
        Hand1.Reset()
        Hand2.Reset()
        Hand3.Reset()
        Hand4.Reset()

        If TrickState IsNot Nothing Then TrickState.Reset()
        If TrickHistory IsNot Nothing Then TrickHistory.Reset()

        CenterPanel.Children.Clear()

        iTeamDeclarer = 0
        iTeamOpponent = 0
        HistoryTextBox.Text = "Trick History: " & Environment.NewLine
        sRufAs = ""
        RufAs.CardOwner = CType(-1, CardOwner)
        RufAs.CardType = -1
        sk.iCoSpieler = -1
        sk.iGeber = sk.iGeber + 1
        If sk.iGeber = 4 Then sk.iGeber = 0
        nextMove = sk.iGeber
        sk.leadPlayer = sk.iGeber
        GameStatus = 2
        cbxDeclarer.SelectedIndex = 4
        cbxContractSuit.SelectedIndex = 8
        PlayCard.IsEnabled = False
        labelTrumpLead.Content = "        "
        labelTrumpcard.Content = "Display for Game Type"

        ' Karten Mischen = Shuffle Cards
        CardsDeck.Shuffle()

        Dim cardShuffled As PlayingCard = New PlayingCard()

        Dim i As Integer = 0

        Dim testValue As Integer = 0

        ' Deal and sort cards
        For Each cardShuffled In CardsDeck.Cards
            AddHandler cardShuffled.Click, AddressOf card_Click

            testValue = i Mod 4

            If testValue = 0 Then
                cardShuffled.CardOwner = CardOwner.North
                Hand0.AddCard(cardShuffled)
            End If

            If testValue = 1 Then
                cardShuffled.CardOwner = CardOwner.East
                Hand1.AddCard(cardShuffled)
            End If

            If testValue = 2 Then
                cardShuffled.CardOwner = CardOwner.South
                Hand2.AddCard(cardShuffled)
            End If
            If testValue = 3 Then
                cardShuffled.CardOwner = CardOwner.West
                Hand3.AddCard(cardShuffled)
            End If
            i += 1
        Next

        Hand0.RateCardValue(1, CType(1 * 100 + 100, Color), CType(3, GameMode))
        Hand0.SortByDescending(CardSortType.KindOnly)
        Hand1.RateCardValue(1, CType(1 * 100 + 100, Color), CType(3, GameMode))
        Hand1.SortByDescending(CardSortType.KindOnly)
        Hand2.RateCardValue(1, CType(1 * 100 + 100, Color), CType(3, GameMode))
        Hand2.SortByDescending(CardSortType.KindOnly)
        Hand3.RateCardValue(1, CType(1 * 100 + 100, Color), CType(3, GameMode))
        Hand3.SortByDescending(CardSortType.KindOnly)
        Me.CircDeck.AddHandler(ToggleButton.CheckedEvent,
                              New RoutedEventHandler(AddressOf OnCardSelected))
        CardsDeck.Cards.Clear()

End Sub

Selection of the Declarer and the Game Type

The selection of the declarer and the game type are also human controlled (by the user).

You have to follow the steps as shown in the menu on top.

1. New Game

A click on that menu item starts the CardsDeck.Shuffle method.

After that, the shuffled cards are distributed to the four ListBoxes / CardPanels.

2. Select Declarer

From the combobox on the right of this label, you can select the declarer of the game (who plays a solo or calls an ace).

3. Select GameType

From the combobox on the right of this label, you can select which game type the declarer of the game wants to play – select which solo he wants to play or which ace he wants to call.

Menu item 4. Ready to Play is only active after steps 2. And 3. are completed.

After you clicked it, the Auto Play feature moves a card to the CenterPanel or - if it is the human player's turn – nothing happens until the human player clicked on one of his cards.

The label "Waiting for Card from Player:“ shows whose turn is next.

Place a Card on the CenterPanel

If it is the human player's turn, he can play one of them by clicking on one of his cards.

The clicked card is then automatically moved to the DockPanel CenterPanel.

VB.NET
Private Sub card_Click(ByVal sender As Object, ByVal e As System.EventArgs)

        Dim ACP As New AutoCardPlay(sk.trumpCard, Me)
        Dim cardsPanel As Object = {ListBox0, ListBox1, ListBox2, ListBox3}
        Dim hand As HandCards() = {Hand0, Hand1, Hand2, Hand3}

        Try

            If sender.CardOwner = 2 Then
                If processing Then Return
                processing = True

                If CenterPanel.Children.Count = 4 Or Hand4.Cards.Count = 4 Then
                    CenterPanel.Children.Clear()
                    Hand4.Reset()
                    HistoryTextBox.AppendText(Environment.NewLine &
                                        "-----------------------" & Environment.NewLine)
                End If

                sender.IsAlreadyPlayed = True
                SetCards(TrickState, sender.CardType, sender.CardValue)

                Panel2.Children.Remove(sender)
                TrickState.AddCard(sender)

                Dim cardColor As String
                Dim cardValue As String
                Dim cardOwner As String

                If sender.CardType = 0 Then cardColor = "Ꚛ"
                If sender.CardType = 1 Then cardColor = "♥"
                If sender.CardType = 2 Then cardColor = "♠"
                If sender.CardType = 3 Then cardColor = "Ⴖ"

                cardValue = sender.CardValue

                If sender.CardValue = 2 Then cardValue = "U"
                If sender.CardValue = 3 Then cardValue = "O"
                If sender.CardValue = 4 Then cardValue = "K"
                If sender.CardValue = 11 Then cardValue = "A"

                If sender.CardOwner = 0 Then cardOwner = "North"
                If sender.CardOwner = 1 Then cardOwner = "East   "
                If sender.CardOwner = 2 Then cardOwner = "South"
                If sender.CardOwner = 3 Then cardOwner = "West  "

                If sender.CardType = RufAs.CardType 
                    AndAlso sender.CardShortName = "A" Then
                    If GameModus = GameMode.AssenSpiel Then
                        RufAs.IsAlreadyPlayed = True
                        RufAs.CardOwner = CType(2, CardOwner)
                        iCoSpieler = 2
                    End If
                End If

                If GameModus <> GameMode.AssenSpiel Then
                    RufAs.CardOwner = CType(-1, CardOwner)
                End If

                HistoryTextBox.AppendText(Environment.NewLine &
                                      cardOwner & ": " & cardColor & " " & cardValue)

                sender.IsAlreadyPlayed = True

                If sender.CardOwner = 2 Then Hand2.RemoveCard(sender)

                Hand4.AddCard(CType(sender, UIElement))
                System.Windows.Forms.Application.DoEvents()
                System.Threading.Thread.Sleep(250)

                TrickHistory.PrevCard4 = "Unknown"

                If totalMove Mod 4 = 0 Then TrickHistory.PrevCard1 = TrickState.Card1
                If totalMove Mod 4 = 0 Then TrickHistory.PrevCard2 = TrickState.Card2
                If totalMove Mod 4 = 0 Then TrickHistory.PrevCard3 = TrickState.Card3
                If totalMove Mod 4 = 0 Then
                    If TrickState.Card4 IsNot Nothing Then 
                        TrickHistory.PrevCard4 = TrickState.Card4
                End If

                If totalMove Mod 4 = 1 Then
                    TrickState.Card1 = cardValue.ToString & " " & cardColor
                    TrickState.Card2 = Nothing
                    TrickState.Card3 = Nothing
                    TrickState.Card4 = Nothing
                    TrickState.PlayerIdCard2 = -1
                    TrickState.PlayerIdCard3 = -1
                    TrickState.PlayerIdCard3 = -1

                    SetCardsProps(sender)

                End If

                If totalMove Mod 4 = 2 Then TrickState.Card2 = cardValue.ToString & 
                                                                  " " & cardColor
                If totalMove Mod 4 = 3 Then TrickState.Card3 = cardValue.ToString & 
                                                                  " " & cardColor
                If totalMove Mod 4 = 0 Then TrickState.Card4 = cardValue.ToString & 
                                                                  " " & cardColor

                If totalMove Mod 4 = 1 Then TrickState.PlayerIdCard1 = nextMove
                If totalMove Mod 4 = 2 Then TrickState.PlayerIdCard2 = nextMove
                If totalMove Mod 4 = 3 Then TrickState.PlayerIdCard3 = nextMove
                If totalMove Mod 4 = 0 Then TrickState.PlayerIdCard4 = nextMove

                If totalMove Mod 4 = 1 Then
                    sWenz = ""
                    sOber = ""
                    If sender.CardValue = 2 Or sender.CardValue = 3 Then
                        If sk.trumpCardSuit <> "Wenz" Then
                            If totalMove Mod 4 = 1 Then sk.leadSuit = sk.trumpCard
                        End If
                    Else
                        sk.leadSuit = sender.CardType
                    End If

                    If sender.CardValue = 2 Then
                        If sk.trumpCardSuit = "Wenz" Then
                            If totalMove Mod 4 = 1 Then sk.leadSuit = sk.trumpCard
                        End If
                    Else
                        If sk.trumpCardSuit = "Wenz" Then sk.leadSuit = sender.CardType
                    End If
                    labelTrumpLead.Content = "Trump or Lead: " & 
                                                 sk.suitRows(sk.leadSuit)
                End If

                hand(nextMove).GetTeam(hand(nextMove), Me)
                hand(nextMove).IsTrickOur(hand(nextMove), Me)
                nextMove = (nextMove + 1) Mod 4
                updateTurnToMoveMessage(nextMove)

                If totalMove Mod 4 = 0 Then
                    tally()

                    For Each card As PlayingCard In TrickState.Cards
                        card.IsAlreadyPlayed = True
                        TrickHistory.AddCard(card)
                    Next

                    GetPlayedTrumpsCount(TrickHistory, sk.trumpCard)
                    TrickState.Reset()
                    TrickState.CurrentTrickWinner = -2

                    GameStatus = GameState.FirstCardInTrick
                    System.Threading.Thread.Sleep(500)
                Else
                    GameStatus = GameState.AnotherCardInTrick
                End If

                totalMove += 1

                For i = 0 To 3
                    If GameStatus.ToString = "SpielAus" Then Exit Sub
                    If nextMove = 2 Then
                        processing = False
                        If nextMove = 2 Then Exit Sub
                    Else
                        If nextMove = i Then ACP.SelectCard(hand(nextMove), nextMove, 
                                                            sk.declarer, GameStatus, 
                                                            cardsPanel(nextMove), 
                                                            sk.trumpCard, Nothing, Me, 
                                                            sk.leadSuit)
                        If nextMove = i Then If i > 0 Then 
                            GameStatus = GameState.AnotherCardInTrick
                    End If
                Next

                processing = False

            End If

        Catch ex As Exception
            MessageBox.Show(String.Format("{0}{1}", Environment.NewLine, ex.ToString()))
            Debug.Print(String.Format("{0}{1}", Environment.NewLine, ex.ToString()))
        End Try

    End Sub

If it is the auto player's turn, the Public Sub AutoPlaceCardOnTable method does something similar like the Sub card_Click.

At the end of this method:

VB.NET
ACP.SelectCard(hand(nextMove), nextMove, sk.declarer, GameStatus,
    cardsPanel(nextMove), sk.trumpCard, Nothing, Me, sk.leadSuit)

is called. ACP is a New AutoCardPlay object.

With nextMove, we control whose turn it is to play a card.

In Sub SelectCard, we make a difference between the first card of a trick and the other cards of a trick.

For the first card of a trick, the methods SelectBestFirstCard and WenzBestFirstCard are relevant.

For the other cards of a trick, the method SelectBestReturnCard is normally used.

These methods may call other Functions or Subs like:

  • OptimizeSelection
  • PlayTogether_WenzUsage
  • and many others which may appear later when the Game Logic will be presented.

Often used method is IsCardLower which is very important for comparing values of cards. The original version was taken from [7]. It uses a special card value rating method for Schafkopf.

At the end of the SelectCard method, we use the following code:

VB.NET
If FindCard IsNot Nothing Then
    CardsPanel.ItemsSource.Remove(FindCard)
    Wnd.AutoPlaceCardOnTable(FindCard, PlayerID)
End If

to remove the CurrentCard from the players CardsPanel and call the AutoPlaceCardOnTable method again to move the CurrentCard to the CenterPanel and go on with Auto Play.

Auto Play Feature

At the end of:

VB.NET
Public Sub AutoPlaceCardOnTable
. . .
. . .
    Dim cardsPanel As Object = {ListBox0, ListBox1, ListBox2, ListBox3}
    Dim hand As HandCards() = {Hand0, Hand1, Hand2, Hand3}
    For i = 0 To 3
        If GameStatus.ToString = "SpielAus" Then Exit Sub
        If nextMove = 2 Then
            If nextMove = 2 Then Exit Sub
        Else
            If nextMove = i Then ACP.SelectCard(hand(nextMove), nextMove, sk.declarer, 
               GameStatus, cardsPanel(nextMove), sk.trumpCard, Nothing, Me, sk.leadSuit)
            If nextMove = i Then If i > 0 Then GameStatus = GameState.AnotherCardInTrick
        End If
    Next

We take a break If nextMove = 2 (this means Human Player needs to place a card) or run ACP.SelectCard again if nextMove <> 2.

We stop the game on If GameStatus.ToString = "SpielAus".

Implementing Schafkopf Rules

The following code from AutoCardPlay shows how we get a good structure and reusable rules:

VB.NET
#Region "Trump is played, not First Card in Trick"
        If LeadSuitID = TrumpID Then
            ' check if trickWinner is friend = in same team
           hc.GetTeam(hc, Wnd)
           hc.IsTrickOur(hc, Wnd)
            If hc.GetHandTrumpCount(hc, TrumpID) > 0 Then ' hand has trump(s)
               ' All Players 
                If Wnd.TrickState.CountCardsInTrick = 3 And hc.TrickIsOur Then
                    ' trumpSchmear
                    If GetTrumpSchmear_ALL(hc, LeadSuitID, TrumpID) IsNot Nothing Then
                        FindCard = GetTrumpSchmear_ALL(hc, LeadSuitID, TrumpID)
                    Else
                        If GetSchmear_ALL(hc, LeadSuitID, TrumpID) IsNot Nothing Then
                            FindCard = GetSchmear_ALL(hc, LeadSuitID, TrumpID)
                        End If
                    End If
                ElseIf tc.GetWinnerCard.IsHighestPlayableTrumpCard = True _
                       And hc.TrickIsOur = True Then
                    If GetTrumpSchmear_ALL(hc, LeadSuitID, TrumpID) IsNot Nothing Then
                        FindCard = GetTrumpSchmear_ALL(hc, LeadSuitID, TrumpID)
                    End If
                ElseIf Wnd.TrickState.CountCardsInTrick = 3 _
                       And hc.TrickIsOur = False Then
                    ' find higher trump
                    If hc.GetHandNextHigherTrumpCard(TrumpID, 
                                                     Wnd.TrickState.GetWinnerCard, 
                                                     Wnd) IsNot Nothing Then
                        FindCard = hc.GetHandNextHigherTrumpCard(TrumpID, 
                                                     Wnd.TrickState.GetWinnerCard, Wnd)
                    End If
                    ' use high card if trick content is 10 or more points
                ElseIf Wnd.TrickState.GetPointsInTrick > 9 And
                                        Wnd.TrickState.CountCardsInTrick < 3 Then
                    If GetHighestCard(hc, TrumpID, TrumpID) IsNot Nothing Then
                        If tc.IsCardLower(tc.GetWinnerCard, GetHighestCard(hc, TrumpID, 
                                          TrumpID)) Then
                            FindCard = GetHighestCard(hc, TrumpID, TrumpID)
                        End If
                    End If
                End If
                If FindCard Is Nothing And hc.TrickIsOur = False Then
                    ' find Next Higher Trump
                    If hc.GetHandNextHigherTrumpCard(TrumpID, 
                                                     Wnd.TrickState.GetWinnerCard,
                                                     Wnd) IsNot Nothing Then
                        FindCard = hc.GetHandNextHigherTrumpCard(TrumpID, 
                                                     Wnd.TrickState.GetWinnerCard, Wnd)
                    End If
                End If
            End If
            If FindCard Is Nothing Then
                ' find low trump
                If GetLowTrumpCard(hc, LeadSuitID, TrumpID) IsNot Nothing Then
                    If tc.IsCardLower(tc.GetWinnerCard, GetLowTrumpCard(hc, LeadSuitID, 
                                                                        TrumpID)) Then
                        FindCard = GetLowTrumpCard(hc, LeadSuitID, TrumpID)
                    End If
                    If FindCard Is Nothing Then FindCard = GetLowTrumpCard(hc, 
                                                                           LeadSuitID, 
                                                                           TrumpID)
                End If
            End If
        End If
#End Region

We can see that:

  • TrickIsOur Property (which is dependent from Property CurrentTrickWinner; both are in class TrickContent)
  • GetPointsInTrick Property
  • CountCardsInTrick Property
  • IsCardLower method

and some more are needed.

The first check is if the first card of the trick is a trump or a card of another color.

Case trump is played it is good to know how many cards are already in the current trick – case of 3 we get two variants with TrickIsOur = False or true.

The next case is to return a high card if the trick content value is 10 or more points.

In these three cases, we use methods GetTrumpSchmear_ALL, GetHandNextHigherTrumpCard and GetHighestCard to find a possible return card – in one case, combined with method IsCardLower.

The other cases are needed if less than 3 cards are in the current trick.

Used methods are GetLowestCard or again GetHighestCard.

The used Functions are mainly located in the Extension Modules like AllPlayers which has a high number of methods.

Image 2

Image 3

Similar code is needed for #Region "Other Color than trump is played".

The third variant is #Region " LeadSuit n.a. => check for trump (with OR without U or O)".

These three code regions were all inspired by [6].

Teams and class HandCards

It is important to know to which team the current player belongs and who is the current winner of the current trick.

We get this info with:

VB.NET
hc.GetTeam(hc, Wnd)

hc.IsTrickOur(hc, Wnd)

from HandCards.

VB.NET
Public Sub GetTeam(hc As HandCards, Wnd As MainWindow)

            If hc.HasCard(Wnd.RufAs.CardValue, Wnd.RufAs.CardType) Then
                If Wnd.GameModus = GameMode.AssenSpiel _
                                   And Wnd.RufAs.CardOwner = -1 Then
                    Wnd.RufAs.CardOwner = CType(PlayerID, CardOwner)
                End If
            End If

            If hc.PlayerID <> Wnd.sk.declarer And hc.PlayerID <> Wnd.iCoSpieler And
                    Wnd.RufAs.CardOwner <> hc.PlayerID Then
                _TeamDeclarer = False
                _TeamOpponent = True
            End If

            If Wnd.RufAs.CardOwner = hc.PlayerID Or hc.PlayerID = Wnd.sk.declarer Or
                    hc.PlayerID = Wnd.iCoSpieler Then
                _TeamOpponent = False
                _TeamDeclarer = True
            End If

            HandIsInTeamDeclarer = _TeamDeclarer
            HandIsInTeamOpponent = _TeamOpponent

   End Sub

   Public Sub IsTrickOur(hc As HandCards, Wnd As MainWindow)

            If HandIsInTeamDeclarer = True Then
                If Wnd.TrickState.CurrentTrickWinner = Wnd.sk.declarer Or
                    Wnd.TrickState.CurrentTrickWinner = Wnd.iCoSpieler Or
                    Wnd.TrickState.CurrentTrickWinner = Wnd.RufAs.CardOwner Then
                    TrickIsOur = True
                Else
                    TrickIsOur = False
                End If
            End If

            If HandIsInTeamOpponent = True Then
                If Wnd.TrickState.CurrentTrickWinner <> Wnd.sk.declarer And
                   Wnd.TrickState.CurrentTrickWinner <> Wnd.iCoSpieler And
                   Wnd.TrickState.CurrentTrickWinner <> Wnd.RufAs.CardOwner Then
                    TrickIsOur = True
                Else
                    TrickIsOur = False
                End If
            End If
  End Sub

More Game Rules

Many of the "rules" are done with "If, Then, ElseIf ..." statements.

VB.NET
Public Function SelectBestFirstCard(ByVal CardsPanel As Object, PlayerID As Integer,
                                         DeclarerID As Integer, GameStatus As Object,
                                         sHandCards As Object,  TrumpID As Integer,
                                         hand As HandCards, Wnd As MainWindow,
                                         LeadSuitID As Integer) As PlayingCard
    Dim sk As New Schafkopf
    Dim FindCard As PlayingCard
    If hand Is Nothing Then MessageBox.Show("AutoCardPlay *** hand Is Nothing")
    hc = hand
    If Wnd.GameOver = True Then Exit Function
    If GameStatus.ToString = "SpielAus" Then Wnd.GameOver = True
    If GameStatus.ToString = "SpielAus" Then Exit Function

    With CardsPanel.Items
        ' TeamDeclarer
        ' PlayerID = DeclarerID Or PlayerID = Wnd.iCoSpieler
        If .Count > 0 AndAlso hc.HandIsInTeamDeclarer = True Then
            If sHandCards.ToString.Contains("A") = True AndAlso
                DeclarerID = PlayerID Then
                If Wnd.iTricks = 6 Or Wnd.iTricks = 7 Or Wnd.iTricks = 8 Then
                    ' Nach Assen(ex RufAs) suchen?
                    If FindCardByKind(hc, 11) IsNot Nothing Then
                        If FindCardByKind(hc, 11).CardType = LeadSuitID Then
                            FindCard = FindCardByKind(hc, 11)
                       End If
                    End If
                End If
            Else
                If hc.GetHighestCard(LeadSuitID, TrumpID) IsNot Nothing And
                       hc.GetHandTrumpCount(hc, TrumpID) > 1 Then
                    FindCard = hc.GetHighestCard(LeadSuitID, TrumpID)
                    ' CardsPanel.Items.Item(n)
                End If
            End If
            'Next
        End If

        If .Count > 0 AndAlso hc.HandIsInTeamDeclarer = True Then
            If SelectFirstCardTrumpCheck_TD(hc, Wnd, CardsPanel, TrumpID,
                                            LeadSuitID) IsNot Nothing Then
                FindCard = SelectFirstCardTrumpCheck_TD(hc, Wnd, CardsPanel,
                                                        TrumpID, LeadSuitID)
            End If
        End If

        ' TeamOpponent
        ' RufAs Suchen (wenn nicht CoSpieler)
        If hc.HandIsInTeamOpponent = True Then
            If SelectFirstCardCallAceCheck_TO(hc, Wnd, CardsPanel, TrumpID,
                                              LeadSuitID) IsNot Nothing Then
                FindCard = SelectFirstCardCallAceCheck_TO(hc, Wnd, CardsPanel,
                                                          TrumpID, LeadSuitID)
                If FindCard IsNot Nothing Then LeadSuitID = FindCard.CardType
           End If
        End If

    End With

    ' All Players - If FindCard Is Nothing
    If FindCard Is Nothing Then Debug.Print("ACP 304 FindCard Is Nothing")
    If CaseFindFirstCardIsNothing(hc, Wnd, CardsPanel, TrumpID,
                                  LeadSuitID) IsNot Nothing Then
        FindCard = CaseFindFirstCardIsNothing(hc, Wnd, CardsPanel,
                                              TrumpID, LeadSuitID)
    End If

    Return FindCard

End Function

Other methods use Linq which is easier to read and understand:

VB.NET
<Extension()>
Public Function FindCardByKind(hand As HandCards, i As Integer) As PlayingCard
    If i > 0 Then
        If hand.Cards _
            .OrderBy(Function(card) card.CardValue) _
                   .Where(Function(card) card.CardValue = CType(i, CardValue)) _
     .Where(Function(card) card.CardType <> hand.TrumpID) _
            .FirstOrDefault IsNot Nothing Then
            Return hand.Cards _
            .OrderBy(Function(card) card.CardValue) _
                   .Where(Function(card) card.CardValue = CType(i, CardValue)) _
     .Where(Function(card) card.CardType <> hand.TrumpID) _
           .FirstOrDefault
       End If
   Else
       Return Nothing
   End If
End Function

TrickContent is a very important class (based on [7]) which we need for using method IsCardLower or getting IsTrickOur.

IsCardLower compares newCardA.GetCardValue and newCardB.GetCardValue with the usage of a special rating method for the CardValue – see code in class PlayingCard Function GetCardValue. Rating method is based on project [7].

VB.NET
Public Class TrickContent : Inherits ObservableObject

    ' for points calc used
    Public Property Card1 As String
    Public Property Card2 As String
    Public Property Card3 As String
    Public Property Card4 As String

    Public Property WenzAs1stCard As Integer

    Public Property CurrentTrickWinner As Integer                 
    ' bezieht sich auf PlayerID 

    Public Property PlayerIdCard1 As Integer
    Public Property PlayerIdCard2 As Integer
    Public Property PlayerIdCard3 As Integer
    Public Property PlayerIdCard4 As Integer

    Public Property PrevCard1 As String
    Public Property PrevCard2 As String
    Public Property PrevCard3 As String
    Public Property PrevCard4 As String

    Private _points As Integer
    Private _countValue As Integer

    Private WinnerIndex As Integer = 0
    Private ReadOnly GameType As GameMode
    Private ReadOnly TrumpColor As Color

    Public Sub New(ByVal gameType As GameMode, ByVal trump As Color, 
                   Optional ByVal startPlayer As Integer = 0)
        Me.Cards = New ObservableCollection(Of PlayingCard)
        AddHandler Cards.CollectionChanged, AddressOf CardCollectionChanged
        Me.GameType = gameType
        TrumpColor = trump
    End Sub

    Public Property GetWinnerCard As PlayingCard
    Public ReadOnly Property Cards As ObservableCollection(Of PlayingCard)

    Private Sub CardCollectionChanged(sender As Object, 
                                      e As NotifyCollectionChangedEventArgs)
        OnPropertyChanged(NameOf(Count))
    End Sub

    Public Sub Reset()
        Cards.Clear()
        _points = 0
    End Sub

    Public Sub AddCard(card As PlayingCard)
        If Cards.Contains(card) Then
            Throw New InvalidOperationException($"Trick already contains card {card}.")
        End If
        Cards.Add(card)
        _countValue = Cards.Count
        If _countValue = 0 Then WinnerIndex = -2
        If _countValue > 0 Then
            CalcWinnerCard(card)
        End If
    End Sub

    Public Sub RemoveCard(card As PlayingCard)
        'If Cards.Contains(card) = False Then
        '    Throw New InvalidOperationException($"Hand does not contain card {card}.")
        'End If
        Cards.Remove(card)
    End Sub

    Public ReadOnly Property CountCardsInTrick As Integer
        Get
            Return Cards.Count
        End Get
    End Property

    Public ReadOnly Property Count As Integer
        Get
            Return _countValue
        End Get
    End Property

    Public ReadOnly Property GetPointsInTrick As Integer
        Get
            _points = 0
            For Each card As PlayingCard In Cards
                _points += card.GetPoints
            Next
            Return _points
        End Get
    End Property

    Private Sub CalcWinnerCard(ByVal newCard As PlayingCard)
        'Check which one is higher
        If _countValue = 1 Then
            WinnerIndex = 1
            If Cards.Item(_countValue - 1) Is Nothing Then
            End If
            GetWinnerCard = Cards.Item(0)
            '_WinnerCardOwner = Cards.Item(0).CardOwner
            CurrentTrickWinner = Cards.Item(0).CardOwner
        End If
        If _countValue > 1 Then
            If IsCardLower(GetWinnerCard, newCard) Then
                WinnerIndex = _countValue
                GetWinnerCard = newCard
                CurrentTrickWinner = newCard.CardOwner
            End If
        End If
    End Sub

    Public Function OnePrevCardContainsO() As Boolean
        If PrevCard3 IsNot Nothing Then
            If PrevCard1.Contains("O") Or PrevCard2.Contains("O") Or 
                PrevCard3.Contains("O") Or
                PrevCard4.Contains("O") Then Return True
        End If
        Return False
    End Function

    Public Function IsCardLower(ByVal newCardA As PlayingCard, 
                                ByVal newCardB As PlayingCard) As Boolean
        Dim s As GameMode
        s = GameMode.Sauspiel
        If GameType.ToString = "AssenSpiel" Then s = GameMode.Sauspiel
        If GameType.ToString = "Solo" Then s = GameMode.Farbsolo
        If GameType.ToString = "Wenz" Then s = GameMode.Wenz
        If newCardA IsNot Nothing And newCardB IsNot Nothing Then
            If newCardA.GetCardValue(s, TrumpColor, 
                                     Me.Cards.Item(0)) < newCardB.GetCardValue(s, 
                                     TrumpColor, Me.Cards.Item(0)) Then
               Return True
            End If

            Return False

        End If

    End Function

End Class

And here is a Sample for an Extension Module which shows the usage of FindCardByKind(hand, 4) to find cards with a certain CardValue or Function SelectFirstCardTrumpCheck_TD which returns a PlayingCard case bPlayHighestTrump is true.

VB.NET
Module TeamDeclarer

    Private sO As String
    Private sU As String = "U"

    ' SelectCard (starting point in AutoCardPlay)
    ' ALL = All Players; TD = Team Declarer; TO = Team Opponent; 
    ' TC = TrickContent; Ext = Extension Module

    <Extension()>
    Public Function SelectNextCardCommonCheck_TD(hand As HandCards,
                     Wnd As MainWindow, ByVal CardsPanel As Object,
                     TrumpID As Integer, LeadSuitID As Integer) As PlayingCard
        
        '----------------------------------------------------------
        ' Extension of HandCards
        ' Calls From AutoCardPlay 
        ' Not FirstCardInTrick
        ' TeamDeclarer
        ' PlayerID = DeclarerID Or PlayerID = sk.iCoSpieler
        ' LeadSuit HandCards = playable cards
        '----------------------------------------------------------

        Dim FindCard As PlayingCard = Nothing

        Dim sHand = hand.GetHandPlayableCardsString(LeadSuitID)

        If sHand IsNot Nothing AndAlso Wnd.sRufAs IsNot Nothing Then
            If sHand.ToString.Contains(Wnd.sRufAs) Then
                If Wnd.GameModus = GameMode.AssenSpiel Then
                    Wnd.RufAs.CardOwner = CType(hand.PlayerID, CardOwner)
                Else
                    Wnd.RufAs.CardOwner = CardOwner.NONE
                End If
            End If
        End If

        If FindCardByKind(hand, 7, 10) IsNot Nothing Then
            If FindCardByKind(hand, 7, 10).CardType = LeadSuitID Then
                FindCard = FindCardByKind(hand, 7, 10)
            End If
        End If
        If FindCardByKind(hand, 4) IsNot Nothing Then
            If FindCardByKind(hand, 4).CardType = LeadSuitID Then
                FindCard = FindCardByKind(hand, 4)
            End If
        End If        

        ' Nach Assen (ex RufAs) suchen?
        If FindCardByKind(hand, 11) IsNot Nothing Then
            If FindCardByKind(hand, 11).CardType = LeadSuitID Then
                FindCard = FindCardByKind(hand, 11)
            End If
        End If

        If FindCard IsNot Nothing Then Return FindCard

    End Function

    <Extension()>
    Public Function SelectFirstCardTrumpCheck_TD(hc As HandCards,
                                                 Wnd As MainWindow, 
                                                 ByVal CardsPanel As Object,
                                                 TrumpID As Integer, 
                                                 LeadSuitID As Integer) As PlayingCard
        ' ----------------------------------------------------------
        ' Extension of HandCards
        ' Calls from AutoCardPlay 
        ' bTeamDeclarer => should play high trump
        ' PlayerID = DeclarerID Or PlayerID = Wnd.iCoSpieler
        ' ----------------------------------------------------------

        If TrumpID = 4 Then sO = "X"
        If TrumpID <> 4 Then sO = "O"

        Dim FindCard As PlayingCard = Nothing

        With CardsPanel.Items
            For n = 0 To .Count - 1
                If hc.GetHandTrumpCount(hc, TrumpID) > 1 Then
                    If .Item(n).ToString.Contains(sO) Or 
                        .Item(n).ToString.Contains("U") Then
                        LeadSuitID = TrumpID
                        Wnd.sk.leadSuit = TrumpID
                        If Wnd.bPlayHighestTrump = True Then
                            Wnd.bPlayHighestTrump = False
                            FindCard = .Item(n)
                            Return FindCard
                        Else
                            FindCard = .Item(n)
                            Wnd.bPlayHighestTrump = True
                        End If
                    End If
                End If
            Next

        End With

        If FindCard IsNot Nothing Then Return FindCard

    End Function

End Module

Game UI

If you do not want to see exactly which cards the other players have, enable this code in Mainwindow method updateContract:

VB.NET
'For n = 0 To Panel0.Children.Count - 1
'    Panel0.Children.Item(n).Opacity = 0.025
'Next

'For n = 0 To Panel3.Children.Count - 1
'    Panel3.Children.Item(n).Opacity = 0.025
'Next

After you selected declarer and game type and 4. Ready to Play was pressed, the UI changes.

Cards Tracking and other Details

The related class(es) handle(s) some special cases like a human player would do.

One of them is called AIBase, however technically it is not an AI.
But the results seem to be comparable to an AI which was trained or has learned to play  Schafkopf.

For Cards Tracking we are also using class TrickContent with extension Module Extensions_TrickMonitoring

What we are doing like a human player would do is for example:

  • Check if a color [suit] was already played in the current game:

  Public Function IsLeadSuitPlayedTwice

  • Check if the "CallAce" was already played because we want to know if we should take a higher or lower trump:

Public Function IsGetMediumHigherTrumpOk

Public Function IsToSchmearOK

  • Public Sub SetCards in Modul Extensions_TrickMonitoring for example is used to get:

PlayingCard Property IsHighestPlayableTrumpCard

Namespace Schafkopf_OOP.aiLogic

    Public Class AIBase


#Region "Fields And Properties"

        Private iRufAsOwner As Integer
        Private tc As TrickContent
        'Private TrickSimulate As TrickContent
        Private hc As HandCards

#End Region

#Region "Initializations"

        Public Sub New(TrumpID As Integer, MyWnd As MainWindow)
            tc = MyWnd.TrickState
            iRufAsOwner = MyWnd.RufAs.CardOwner
            If MyWnd.GameModus = GameMode.Solo Then iRufAsOwner = -1
            If MyWnd.GameModus = GameMode.Wenz Then iRufAsOwner = -1
            'Debug.Print("AI 35  iRufAsOwner= " & iRufAsOwner.ToString)
        End Sub

        Private Sub InitHand(ByVal CardsPanel As Object, PlayerID As Integer,
                                                  DeclarerID As Integer, 
                                                  GameStatus As Object,
                                                  sHandCards As Object, 
                                                  TrumpID As Integer,
                                                  hc As HandCards,
                                                  Wnd As MainWindow, 
                                                  LeadSuitID As Integer)

            With hc
                '.TrumpID = TrumpID
                '.GetCardTypeInfo(hc, LeadSuitID)
                '.GetTeam(hc, Wnd)
            End With

        End Sub

#End Region

#Region "AI"

        Public Function CallAceDownBy(hand As HandCards, suit As Integer, 
                                      TrumpCardID As Integer) As PlayingCard
            ' case the call ace owner has 4 cards with call ace cardType / Color

            If TrumpCardID <> 4 And suit <> TrumpCardID Then
                If hand.Cards _
                           .OrderBy(Function(card) card.CardValue) _
                                        .Where(Function(card) card.CardValue > 3) _
                                                    .Where(Function(card) card.CardType = suit) _
                            .FirstOrDefault IsNot Nothing Then
                    If hand.Cards _
                               .OrderBy(Function(card) card.CardValue) _
                                            .Where(Function(card) card.CardValue > 3) _
                                                        .Where(Function(card) card.CardType = suit) _
                               .Count > 3 Then
                        Return hand.Cards _
                                .OrderBy(Function(card) card.CardValue) _
                                            .Where(Function(card) card.CardValue > 3) _
                                                        .Where(Function(card) card.CardType = suit) _
                                .FirstOrDefault
                    End If
                End If
            End If

        End Function

        Public Function WenzPlayingIsOK(Wnd As MainWindow) As Boolean
            If Wnd.TrickHistory.OnePrevCardContainsU = False And 
                Wnd.TrickHistory.Cards.Item(0).ToString.Contains("U") = False Then
                WenzPlayingIsOK = True
            Else
                WenzPlayingIsOK = False
            End If

        End Function

        Public Function IsLeadSuitPlayedTwice(Wnd As MainWindow, 
                                              LeadSuitID As Integer) As Boolean

            'IsLeadSuitPlayedTwice = False
            If LeadSuitID = 0 AndAlso Wnd.ShellsColor.IsPlayedTwice = True Then Return True
            If LeadSuitID = 1 AndAlso Wnd.HeartsColor.IsPlayedTwice = True Then Return True
            If LeadSuitID = 2 AndAlso Wnd.SpadesColor.IsPlayedTwice = True Then Return True
            If LeadSuitID = 3 AndAlso Wnd.AcornColor.IsPlayedTwice = True Then Return True

            Return False

        End Function

        Public Function IsToSchmearOK(Wnd As MainWindow, hand As HandCards, 
                            suit As Integer, TrumpCardID As Integer) As Boolean

            Dim IsSchmearOK As Boolean

            'Solo Player Is 1st in trick And plays low trump card with 
            'CardRatedValue < about 500 Or 550 && opponents still have more than 1 trump
            ' Info:  CardRatedValue Is defined in class PlayingCard

            If (tc.CountCardsInTrick = 1 And
            Wnd.GameModus = GameMode.Solo And
            tc.CurrentTrickWinner = Wnd.sk.declarer And
            Wnd.iTricks < 5 And
            tc.GetWinnerCard.CardRatedValue < 555) Then
                IsSchmearOK = True

            ElseIf (tc.CountCardsInTrick > 0 And
            Wnd.GameModus = GameMode.AssenSpiel And
            tc.CurrentTrickWinner = Wnd.sk.declarer And
            tc.GetWinnerCard.IsHighestPlayableTrumpCard = True And
            hand.TrickIsOur) Then
                IsSchmearOK = True

            ElseIf (tc.CountCardsInTrick = 2 And
            Wnd.GameModus = GameMode.Solo And
            tc.Cards.First().CardOwner = Wnd.sk.declarer And
            hand.TrickIsOur) Then
                IsSchmearOK = True

            ElseIf (tc.CountCardsInTrick = 2 And
            Wnd.GameModus = GameMode.Solo And
            tc.Cards.First().CardOwner = Wnd.sk.declarer And
            tc.GetWinnerCard.CardRatedValue < 550) Then  ' hand.TrickIsOur)
                IsSchmearOK = True

            Else
                IsSchmearOK = False

            End If

            Return IsSchmearOK

        End Function

        Public Function IsGetMediumHigherTrumpOk(Wnd As MainWindow, tc As TrickContent, 
                            PlayerID As Integer, DeclarerID As Integer) As Boolean

            If Wnd.RufAs.IsAlreadyPlayed Or 
               tc.GetCurrentTrickWinnerCard(Wnd) = tc.Card1 Or
               Wnd.GameModus = GameMode.Solo Or Wnd.GameModus = GameMode.Wenz Or
               tc.GetWinnerCard.CardOwner = DeclarerID Or tc.CountCardsInTrick > 2 Then
                  If PlayerID <> DeclarerID Or
                      tc.GetWinnerCard.CardOwner = DeclarerID Then
                      Return True
                  ElseIf tc.CountCardsInTrick > 2 And 
                      tc.GetCurrentTrickWinnerCard(Wnd) <> tc.Card1 Then
                      Return True
                  ElseIf PlayerID = DeclarerID And 
                      tc.GetWinnerCard.CardRatedValue < 1000 Then
                      Return True
                  ElseIf Wnd.RufAs.IsAlreadyPlayed And hand.TrickIsOur = False Or
                      Wnd.GameModus = GameMode.Solo And 
                      hand.TrickIsOur = False Or
                      Wnd.GameModus = GameMode.Wenz And 
                      hand.TrickIsOur = False Or
                      Wnd.RufAs.IsAlreadyPlayed And
                      tc.GetWinnerCard.CardRatedValue < 1000 Then
                      Return True
                  End If
            End If

            Return False

        End Function

#End Region

    End Class

End Namespace

There are much more things which are related to Cards Tracking - explore the source code and you will find it.

I made sure that the computer player doesn't have more information than a human player.
In the current version, the Computer Player is a first-for-all opponent.
It is more important who gets good cards and who gets bad cards.
To get a meaningful result, about 100 games are necessary.
 

Conclusion

The new Version 3.5 or higher reaches a level like a human player with medium playing level.

The redesign was successful – now the code is better structured and reusable.

This is only a demo – but I think it will allow you to play Schafkopf with / against your computer and have a lot of fun.

Final Note

I am very interested in feedback of any kind - problems, suggestions and other.

Credits / References

History

  • 9th February, 2023 - VB Version 3.2
  • 11th February, 2023 - VB Version 3.3 fixed some smaller issues
  • 16th February, 2023 - VB Version 3.4 fixes most of the known issues
  • 21st February, 2023 - C# version: Schafkopf_Cs
  • 13th April, 2023 - Source Code Version 3.5 fixes some issues to improve playing quality
  • 19th April, 2023 - Source Code Version 3.6 fixes some issues for better playing quality
  • 9th February, 2024 - C# Source Code Version 3.8 fixes some important issues for better playing results
  • 17th February, 2024 - New chapter in article: Cards Tracking and other Details; C# and VB.Net Source Code Version 4.0 fixes some issues and adds new cards tracking features for better playing results

License

This article, along with any associated source code and files, is licensed under The Code Project Open License (CPOL)


Written By
Engineer
Germany Germany

Comments and Discussions

 
QuestionI'd suggest you still need to look at teh code and refactor it somewhat. Pin
OriginalGriff16-Feb-24 19:41
mveOriginalGriff16-Feb-24 19:41 
AnswerRe: I'd suggest you still need to look at teh code and refactor it somewhat. Pin
Jo_vb.net17-Feb-24 3:13
mvaJo_vb.net17-Feb-24 3:13 
QuestionTip: Displaying Multiple Languages in a Tab Pin
Graeme_Grant16-Feb-24 13:27
mvaGraeme_Grant16-Feb-24 13:27 
QuestionSchafkopf in WI Pin
pontellen13-Feb-24 7:07
pontellen13-Feb-24 7:07 
AnswerRe: Schafkopf in WI Pin
Jo_vb.net13-Feb-24 22:10
mvaJo_vb.net13-Feb-24 22:10 

General General    News News    Suggestion Suggestion    Question Question    Bug Bug    Answer Answer    Joke Joke    Praise Praise    Rant Rant    Admin Admin   

Use Ctrl+Left/Right to switch messages, Ctrl+Up/Down to switch threads, Ctrl+Shift+Left/Right to switch pages.