Results 1 to 8 of 8

Thread: Help again please!

  1. #1

    Thread Starter
    Member Tmiller's Avatar
    Join Date
    Oct 2015
    Location
    Georgia
    Posts
    34

    Help again please!

    I can not get my cards to show it is showing error and stops
    Code:
    Public Class Form1
       Private hand, deck As New List(Of Card)
       ' this is to load the cards to play
       Private Function LoadDeck() As List(Of Card)
          Dim returnDeck As List(Of Card) = New List(Of Card)
          Dim faces() As String = {"two", "three", "four", "five", "six", "seven", "eight", "nine", "ten", "jack", "queen", "king", "ace"} ' counting of the cards to give value
          Dim current As Card
    
          Dim myString As System.String
          Dim myImage As Bitmap
    
          For Each face As String In faces ' making the suits of the cards
             myString = String.Format("{0}Of{1}s", face, "Club")
             myString = "TwoofClubs"
             myImage = DirectCast(My.Resources.ResourceManager.GetObject(myString), Bitmap)
             current = New Card With {.Face = face, .Suite = Card.SuiteType.Club,
          .Value = Array.IndexOf(faces, face) + 2,
             .Image = myImage}
    
             returnDeck.Add(current)
          Next
    
          For Each face As String In faces
    
             myString = String.Format("{0}Of{1}s", face, "Diamond")
             current = New Card With {.Face = face,
          .Suite = Card.SuiteType.Diamond, .Value = Array.IndexOf(faces, face) + 2,
          .Image = DirectCast(My.Resources.ResourceManager.GetObject(myString), Bitmap)}
             returnDeck.Add(current)
          Next
    
          For Each face As String In faces ' making the suits of the cards
             current = New Card With {.Face = face, .Suite = Card.SuiteType.Club,
             .Value = Array.IndexOf(faces, face) + 2,
             .Image = DirectCast(My.Resources.ResourceManager.GetObject(String.Format("{0}of{1}s.png", .Face, "Club")), Bitmap)}
             returnDeck.Add(current)
          Next
    
          For Each face As String In faces
             current = New Card With {.Face = face,
             .Suite = Card.SuiteType.Diamond, .Value = Array.IndexOf(faces, face) + 2,
             .Image = DirectCast(My.Resources.ResourceManager.GetObject(String.Format("{0}of{1}s.png", .Face, "Diamond")), Bitmap)}
             returnDeck.Add(current)
          Next
    
          For Each face As String In faces
             current = New Card With {.Face = face,
             .Suite = Card.SuiteType.Heart, .Value = Array.IndexOf(faces, face) + 2,
             .Image = DirectCast(My.Resources.ResourceManager.GetObject(String.Format("{0}of{1}s.png", .Face, "Heart")), Bitmap)}
             returnDeck.Add(current)
          Next
    
          For Each face As String In faces
             current = New Card With {.Face = face, .Suite = Card.SuiteType.Spade,
             .Value = Array.IndexOf(faces, face) + 2,
             .Image = DirectCast(My.Resources.ResourceManager.GetObject(String.Format("{0}of{1}s.png", .Face, "Spade")), Bitmap)}
             returnDeck.Add(current)
          Next
    
          Return returnDeck
       End Function
    
       Private r As New Random ' this make the cards come in a random order
       Private Function ShuffleDeck(ByVal deck As List(Of Card)) As List(Of Card)
          Dim randomOrder() As Integer = Enumerable.Range(0, deck.Count - 1).OrderBy(Function(n) r.Next()).ToArray
          Dim shuffledDeck As List(Of Card) = New List(Of Card)
          For Each i As Integer In randomOrder
             shuffledDeck.Add(deck.Item(i))
          Next
          Return shuffledDeck
       End Function
    
       'Keep/Remove Buttons
       Private Sub Button1_Click(sender As Object, e As EventArgs) Handles Button1.Click, Button2.Click, Button3.Click, Button4.Click, keepButton5.Click
          Dim btn As Button = DirectCast(sender, Button)
          Dim keep As Boolean = DirectCast(btn.Tag, Boolean)
          keep = Not keep
    
          btn.Text = If(keep, "Keep", "Remove") ' loop for the keep button using "if" 
       End Sub
       Private initDeal As Boolean = True
       Private Sub Button6_Click(sender As Object, e As EventArgs) Handles Button6.Click ' to show cards
          If initDeal Then
             deck = ShuffleDeck(LoadDeck)
    
             'If initial deal...
             Dim card1 As Card = deck.Item(0)
             Dim card2 As Card = deck.Item(1)
             Dim card3 As Card = deck.Item(2)
             Dim card4 As Card = deck.Item(3)
             Dim card5 As Card = deck.Item(4)
    
             PictureBox1.Image = card1.Image
             PictureBox1.Tag = card1
             PictureBox2.Image = card2.Image
             PictureBox2.Tag = card2
             PictureBox3.Image = card3.Image
             PictureBox3.Tag = card3
             PictureBox4.Image = card4.Image
             PictureBox4.Tag = card4
             PictureBox5.Image = card5.Image
             PictureBox5.Tag = card5
          Else
             'If second attempt
             Dim btn1 As Boolean = DirectCast(Button1.Tag, Boolean)
             Dim btn2 As Boolean = DirectCast(Button2.Tag, Boolean)
             Dim btn3 As Boolean = DirectCast(Button3.Tag, Boolean)
             Dim btn4 As Boolean = DirectCast(Button4.Tag, Boolean)
             Dim btn5 As Boolean = DirectCast(keepButton5.Tag, Boolean)
             Dim counter As Integer = 5
    
             If Not btn1 Then
                PictureBox1.Image = deck.Item(counter).Image
                PictureBox1.Tag = deck.Item(counter)
                counter += 1
             End If
    
             If Not btn2 Then
                PictureBox2.Image = deck.Item(counter).Image
                PictureBox2.Tag = deck.Item(counter)
                counter += 1
             End If
    
             If Not btn3 Then
                PictureBox3.Image = deck.Item(counter).Image
                PictureBox3.Tag = deck.Item(counter)
                counter += 1
             End If
    
             If Not btn4 Then
                PictureBox4.Image = deck.Item(counter).Image
                PictureBox4.Tag = deck.Item(counter)
                counter += 1
             End If
    
             If Not btn5 Then
                PictureBox5.Image = deck.Item(counter).Image
                PictureBox5.Tag = deck.Item(counter)
                counter += 1
             End If
             ' this bring the cards to a count so that it will display the value
             Dim values() As Card = {DirectCast(PictureBox1.Tag, Card), DirectCast(PictureBox2.Tag, Card), DirectCast(PictureBox3.Tag, Card), DirectCast(PictureBox4.Tag, Card), DirectCast(PictureBox5.Tag, Card)}
             If FourOfKind(values) Then
                MessageBox.Show("You got a four of a kind!")
             ElseIf FullHouse(values) Then
                MessageBox.Show("You got a full house!")
             ElseIf Flush(values) Then
                MessageBox.Show("You got a Flush!")
             ElseIf Straight(values) Then
                MessageBox.Show("You got a Striaght!")
             ElseIf ThreeOfKind(values) Then
                MessageBox.Show("You got Three of A Kind!")
             ElseIf TwoPairs(values) Then
                MessageBox.Show("You got two Pair!")
             ElseIf OnePair(values) Then
                MessageBox.Show("You got A Pair!")
             Else
                MessageBox.Show("You got " & values(Array.IndexOf(values, values.Max(Function(c) c.Value))).Face & " high.")
             End If
    
          End If
    
          initDeal = Not initDeal 'Set it to what it was just not
       End Sub
       ' determine the value of the cards
       Private Function FourOfKind(ByVal cards() As Card) As Boolean
          'if the first 4 cards, add values of the four cards and last card is the highest
          If cards(0).Value = cards(1).Value AndAlso cards(0).Value = cards(2).Value AndAlso cards(0).Value = cards(3).Value AndAlso cards(0).Value = cards(4).Value Then
             Return True
          ElseIf cards(1).Value = cards(2).Value AndAlso cards(1).Value = cards(3).Value AndAlso cards(1).Value = cards(4).Value Then
             Return True
          End If
          Return False
       End Function
    
       Private Function FullHouse(ByVal cards() As Card) As Boolean
          'the first three cars and last two cards are of the same value
          'first two cards, and last three cards are of the same value
          If (cards(0).Value = cards(1).Value AndAlso cards(0).Value = cards(2).Value AndAlso cards(3).Value = cards(4).Value) OrElse (cards(0).Value = cards(1).Value AndAlso cards(2).Value = cards(3).Value AndAlso cards(2).Value = cards(4).Value) Then
             Return True
          End If
    
          Return False
       End Function
    
       Private Function Flush(ByVal cards() As Card) As Boolean
          Dim heartsSum As Integer = cards.Count(Function(c) c.Suite = Card.SuiteType.Heart)
          Dim diamondSum As Integer = cards.Count(Function(c) c.Suite = Card.SuiteType.Diamond)
          Dim clubSum As Integer = cards.Count(Function(c) c.Suite = Card.SuiteType.Club)
          Dim spadesSum As Integer = cards.Count(Function(c) c.Suite = Card.SuiteType.Spade)
          'if all suits are the same
          If heartsSum = 5 OrElse diamondSum = 5 OrElse clubSum = 5 OrElse spadesSum = 5 Then
             'if flush, the player with higher cards win
             'whoever has the last card the highest, has automatically all the cards total higher
             Return True
          End If
    
          Return False
       End Function
    
       Private Function Straight(ByVal cards() As Card) As Boolean
          'if 5 consecutive values
          If cards(0).Value + 1 = cards(1).Value AndAlso cards(1).Value + 1 = cards(2).Value AndAlso cards(2).Value + 1 = cards(3).Value AndAlso cards(3).Value + 1 = cards(4).Value Then
             Return True
          End If
    
          Return False
       End Function
    
       Private Function ThreeOfKind(ByVal cards() As Card) As Boolean
          'if the 1,2,3 cards are the same OR
          '2,3,4 cards are the same OR
          '3,4,5 cards are the same
          '3rds card will always be a part of Three of A Kind
          If (cards(0).Value = cards(1).Value AndAlso cards(0).Value = cards(2).Value) OrElse (cards(1).Value = cards(2).Value AndAlso cards(1).Value = cards(3).Value) Then
             Return True
          ElseIf cards(2).Value = cards(3).Value AndAlso cards(2).Value = cards(4).Value Then
             Return True
          End If
    
          Return False
       End Function
    
       Private Function TwoPairs(ByVal cards() As Card) As Boolean
          'if 1,2 and 3,4
          'if 1.2 and 4,5
          'if 2.3 and 4,5
          'with two pairs, the 2nd card will always be a part of one pair 
          'and 4th card will always be a part of second pair
          If cards(0).Value = cards(1).Value AndAlso cards(2).Value = cards(3).Value Then
             Return True
          ElseIf cards(0).Value = cards(1).Value AndAlso cards(3).Value = cards(4).Value Then
             Return True
          ElseIf cards(1).Value = cards(2).Value AndAlso cards(3).Value = cards(4).Value Then
             Return True
          End If
    
          Return False
       End Function
    
       Private Function OnePair(ByVal cards() As Card) As Boolean
          'if 1,2 -> 5th card has the highest value
          '2.3
          '3,4
          '4,5 -> card #3 has the highest value
          If cards(0).Value = cards(1).Value Then
             Return True
          ElseIf cards(1).Value = cards(2).Value Then
             Return True
          ElseIf cards(2).Value = cards(3).Value Then
             Return True
          ElseIf cards(3).Value = cards(4).Value Then
             Return True
          End If
    
          Return False
       End Function
    
    End Class

  2. #2
    Super Moderator Shaggy Hiker's Avatar
    Join Date
    Aug 2002
    Location
    Idaho
    Posts
    38,989

    Re: Help again please!

    Ok, which line throws the error and what's the error message?
    My usual boring signature: Nothing

  3. #3

    Thread Starter
    Member Tmiller's Avatar
    Join Date
    Oct 2015
    Location
    Georgia
    Posts
    34

    Re: Help again please!

    Name:  poker.jpg
Views: 55
Size:  32.5 KB
    Dim btn1 As Boolean = DirectCast(Button1.Tag, Boolean)

  4. #4

    Thread Starter
    Member Tmiller's Avatar
    Join Date
    Oct 2015
    Location
    Georgia
    Posts
    34

    Re: Help again please!

    I cant figure out how to get it to a boolean rather then a string

  5. #5
    Super Moderator Shaggy Hiker's Avatar
    Join Date
    Aug 2002
    Location
    Idaho
    Posts
    38,989

    Re: Help again please!

    Did you put the string "True" or "False" into the .Tag? If not, what did you put in the .Tag?

    You could put True or False into the .Tag, but the string "True" is not the same as the value True. Depending on how you put the value into the .Tag, you would get the string rather than the Boolean. It would be easier to use an Integer. To convert that to a Boolean would be simpler.
    My usual boring signature: Nothing

  6. #6

    Thread Starter
    Member Tmiller's Avatar
    Join Date
    Oct 2015
    Location
    Georgia
    Posts
    34

    Re: Help again please!

    ok yes I put true

  7. #7

    Thread Starter
    Member Tmiller's Avatar
    Join Date
    Oct 2015
    Location
    Georgia
    Posts
    34

    Re: Help again please!

    Now that I changed to integer it has another error

  8. #8

    Thread Starter
    Member Tmiller's Avatar
    Join Date
    Oct 2015
    Location
    Georgia
    Posts
    34

    Re: Help again please!

    Name:  messagebox.jpg
Views: 56
Size:  33.1 KB

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •  



Click Here to Expand Forum to Full Width