Score a poker hand with vba... (1 Viewer)

[Sergeant]

In the course of building a Texas Hold'Em game in Access, I had a hard time finding any code samples for scoring poker hands.
Here is what I came up with... (Please ring in with any suggestions, as I am still developing the application)

'***********
'Purpose: Score poker hand
'Inputs: Absolute card values stored in public array 'MyHand(1 to 5)', suits (ie. "hhcds") stored in public string 'MySuits'
'Parameters: Cards are valued at 2-14 (14 is an ace)
'*************
I updated this code in response to questions raised in reply # 1. Thanks Wayne. I think I got it now, had to change the data type to 'double' and did some other common-sense fixes. I'm still working on improvements.

Public MyHand(1 To 5) As Integer
Private TempHand(1 To 5) As Integer
Public MySuits As String

Public Function ScoreHand() As Double
'This returns a number like [n]nn.nnnnn relevant to the poker hand
'Royal Flush = 140.1432
'Straight Flush = 131.04532 to 139.13209
'Four of a kind = 100.02222 to 112.15553
'Full House = 86.03222 to 98.15543
'Flush = 77.05432 to 84.14319
'Straight = 61.05432 to 70.1432
'Three of a kind = 44.03222 to 56.15542
'Two Pair = 31.03232 to 42.15442
'One Pair = 16.04322 to 28.15431

    'Sort the MyHand array...
    For i = 1 To 5 Step 1
        TempHand(i) = MyHand(i)
    Next i
    For i = 1 To 4 Step 1
        For j = i + 1 To 5 Step 1
            If TempHand(j) < TempHand(i) Then
                tempValue = TempHand(i)
                TempHand(i) = TempHand(j)
                TempHand(j) = tempValue
            End If
        Next j
    Next i
    For i = 1 To 5
        MyHand(i) = TempHand(i)
    Next i
    'Start scoring...
    If CheckStraight Then
        ScoreHand = 56 + TempHand(5)
    Else
        ScoreHand = MatchScore
    End If
    'change decimal format for 2 pair...
    If ScoreHand > 28 And ScoreHand < 44 Then
        i = 2
        j = 3
    Else
        i = 3
        j = 2
    End If
    ScoreHand = ScoreHand + (MyHand(5) * 0.01) + (MyHand(4) * 0.001) + _
        (MyHand(i) * 0.0001) + (MyHand(j) * 0.00001) + (MyHand(1) * 0.000001) + FlushScore
End Function

Private Function CheckStraight() As Boolean
    flag = 0
    If TempHand(1) = 2 And TempHand(5) = 14 Then
        For i = 5 To 2 Step -1
            TempHand(i) = TempHand(i - 1)
        Next i
        TempHand(1) = 1
    End If
    For i = 1 To 4 Step 1
        If TempHand(i + 1) = TempHand(i) + 1 Then
            flag = flag + 1
        End If
    Next i
    CheckStraight = (flag = 4)
End Function

Private Function MatchScore() As Integer
    Dim x As Integer, p As Integer
    For i = 1 To 4 Step 1
        For j = i + 1 To 5 Step 1
            If MyHand(i) = MyHand(j) Then
                x = x + 1
                p = i
            End If
        Next j
    Next i
    Select Case x
        Case Is = 1 'one pair
            MatchScore = 14 + MyHand(p)
        Case Is = 2 'two pair
            MatchScore = 28 + MyHand(4)
        Case Is = 3 'three of a kind
            MatchScore = 42 + MyHand(3)
        Case Is = 4 'full house
            MatchScore = 84 + MyHand(3)
        Case Is = 6 'four of a kind
            MatchScore = 98 + MyHand(3)
        Case Else 'Highest card
            MatchScore = MyHand(5)
    End Select
End Function

Private Function FlushScore() As Integer
    FlushScore = 70
    For i = 2 To 5
        If Left(MySuits, 1) <> Mid(MySuits, i, 1) Then
            FlushScore = 0
            Exit For
        End If
    Next i
End Function

Thanks to the moderator for adding the code tags.
BTW, I am a juvenile coder...if you see any glaringly bad habits in the code, please let me know.

 

[WayneRyan]

Sergeant,

Wow, some very nice logic in there. I put the code into an Access DB and
played with it for a minute.

You said that you developed the scoring for Hold 'em, but it doesn't take
into account the community cards.

But, within it's framework here though (Note: forget about suits):

Player A has --> 2, 2, 8, 8, 9
Player B has --> 2, 3, 3, 8, 8

Both players are awarded scores of 36, but Player B should win. Also,
if both players have 8's over 3's, the current score awards nothing for
the kicker.

Just pointing a few things out, I spent a while tinkering with it. Nice logic
to pick out the different types of hands.

btw,

When you post your code, you can make it look nice by putting in the
#code# and #/code# tags. There pound signs are to be replaced with
the square brackets.

Wayne

 

[Sergeant]

Thanks for the critique...

Wayne, you are saying things that I think I was blocking out for lack of any idea of how to deal with them. (I should have warned that this code overlooked some possibilities.)

1. Community cards: I wrestled with this one in the game db. I decided that each person will select which 5 cards will be evaluated, thereby eliminating the need to loop through the 5 of 7 scenarios for the cards. (I would be interested in how you might deal with this)

2. Two Pair: You caught me out on this one. I really didn't consider that there was a strong likelihood of two people having the same highest pair. Texas Hold'em is about the most likely place for this.

I need to modify the scoring mechanism. Perhaps add two decimal positions that will hold the extra pair/kicker or what have you. Two pair will still be difficult, though, as there are three things to consider (high pair, low pair, kicker).

Overall, though, it was an exercise in turning cards into scores.
I'll keep working on it and update it in the top post.
Sarge.

 

[Sergeant]

Code has been changed...

I fixed my obvious oversights up top.
My next thought is differentiating between two hands that score the same.
ie... two players have full house (threes over deuces), same score (who wins?).

Sarge.

 

[WayneRyan]

Sarge,

Are we back to Hold 'em?

I think the immediate problem is both having Aces over Eights. Who has
the higher kicker.

Wayne

 

[WayneRyan]

Sarge,

Maybe Stewart should (could?) move this to the General Forum. This could
be quite a lengthy dialog. Probably not a FAQ topic.

Wayne

 

[Sergeant]

Sarge,
I think the immediate problem is both having Aces over Eights. Who has
the higher kicker.
Wayne

Actually, the code does differentiate down to the fifth card now. You are probably right, though, that this should be moved to the general (or vba) forum. I think I misunderstood the meaning of this category...it should probably be the final product instead of the first or second edit.

Sarge.

 

[carlnewboult]

would love to get this working but not sure how please can someone advise for a novice thanks

 

[modest]

Please don't update the original code for actual changes made. It makes it hard to follow the thread if you do that. Instead, post the new code and in the original create a link to that post (if needed).

 

[carlnewboult]

sorry about that was jst looking to see if someone had this working yet as it had been a while since there was a last post.