-
Nov 24th, 2015, 07:37 PM
#1
Thread Starter
Member
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
-
Nov 24th, 2015, 08:25 PM
#2
Re: Help again please!
Ok, which line throws the error and what's the error message?
My usual boring signature: Nothing
-
Nov 24th, 2015, 09:16 PM
#3
Thread Starter
Member
Re: Help again please!
Dim btn1 As Boolean = DirectCast(Button1.Tag, Boolean)
-
Nov 24th, 2015, 09:17 PM
#4
Thread Starter
Member
Re: Help again please!
I cant figure out how to get it to a boolean rather then a string
-
Nov 24th, 2015, 09:53 PM
#5
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
-
Nov 24th, 2015, 11:00 PM
#6
Thread Starter
Member
-
Nov 24th, 2015, 11:10 PM
#7
Thread Starter
Member
Re: Help again please!
Now that I changed to integer it has another error
-
Nov 24th, 2015, 11:11 PM
#8
Thread Starter
Member
Posting Permissions
- You may not post new threads
- You may not post replies
- You may not post attachments
- You may not edit your posts
-
Forum Rules
|
Click Here to Expand Forum to Full Width
|