Welcome to Experts Exchange

Add your voice to the tech community where 5M+ people, just like you, are talking about what matters.

  • Help others & share knowledge
  • Earn cash & points
  • Learn & ask questions
Solved

Shuffle Cards

Posted on 2002-07-26
12
341 Views
Last Modified: 2010-05-02
Hi Guys - Just writting some to shuffle up a pack of cards - I have made this to set myself up, but want to know what would be the best way - I wanted to display its progress on a progress bar and slider, as well as calculate the time taken... Any ideas ?

I also have an image list for all the cards. Hearts, Spades etc. So I wanted to show the end result in an image combo box.

If you don't like the code you welcome to change it... :)


Option Explicit
Private Type tCard
    Card As String
    Suit As String
End Type

Private mstrCards(1 To 52) As tCard

Private Sub Form_Load()
Call LoadCards
Call ShuffleCards
End Sub


Private Sub LoadCards()
Dim pstrCards As String
Dim pstrSuits As String
Dim pstrCardArray() As String
Dim pstrSuitArray() As String
Dim i As Integer
Dim x As Integer
x = 1

   pstrCards = ",Ace,Two,Three,Four,Five,Six,Seven,Eight,Nine,Ten,Jack,Queen,King"
   pstrCardArray = Split(pstrCards, ",")
   pstrSuits = ",Hearts,Clubs,Diamonds,Spades"
   pstrSuitArray = Split(pstrSuits, ",")

Do While Not x = 5
    For i = 1 To 13
        mstrCards(i).Card = pstrCardArray(i)
        mstrCards(x).Suit = pstrSuitArray(x)
        Debug.Print mstrCards(i).Card
        Debug.Print mstrCards(x).Suit
    Next
x = x + 1
Loop
End Sub
0
Comment
Question by:hollstar
  • 7
  • 2
  • 2
  • +1
12 Comments
 

Author Comment

by:hollstar
ID: 7179547
How I want to do it, but am not really sure, is have a loop that will swap the cards based upon the current value of the UpDown control instance (and the corresponding buddy text box). The code the loop should randomly select two elemenets fgrom the array and then exchange the contents of those two elements...


You follow me now ?
0
 
LVL 3

Accepted Solution

by:
Gunsen earned 50 total points
ID: 7179617
Type typCard
  Card As Long
  Suit As Long
End Type

Dim Deck(52) As typCard
Dim Cards
Dim Suits
Private Sub Form_Load()
  Cards = Split(",Ace,Two,Three,Four,Five,Six,Seven,Eight,Nine,Ten,Jack,Queen,King", ",")
  Suits = Split(",Hearts,Clubs,Diamonds,Spades", ",")
  For i = 1 To 13
    For j = 1 To 4
      With Deck(i + (j - 1) * 13)
        .Card = i
        .Suit = j
      End With
    Next j
  Next i
  Randomize
 
  For i = 1 To 52
    Dim x As typCard
    Dim y As Long
    y = Int(Rnd * 52) + 1
    x = Deck(y)           ' Swap cards
    Deck(y) = Deck(i)
    Deck(i) = x
  Next i
 
  For i = 1 To 52
    Debug.Print Cards(Deck(i).Card) & " - " & Suits(Deck(i).Suit)
  Next i
0
 

Author Comment

by:hollstar
ID: 7179905
How can I get this into my Image Combo Box with the pics... Say it will have a pic of a heart, and then the word Ace for example...

PS. In the image list itself, I have called them Hearts, Clubs, Diamonds and Spades as the key... :-)
0
Free Tool: IP Lookup

Get more info about an IP address or domain name, such as organization, abuse contacts and geolocation.

One of a set of tools we are providing to everyone as a way of saying thank you for being a part of the community.

 
LVL 2

Expert Comment

by:selim007
ID: 7179907
Option Explicit
Private Type tCard
   Card As String
   Suit As String
End Type

Private mstrCards(1 To 52) As tCard

Private Sub Form_Load()
dim t1 as long
t1=timer            'save the timer value before beginning
Call LoadCards
Call ShuffleCards
t2=timer            'save the new timer value when done
msgbox "Time elapsed:" & (t2-t1)  'calculate the diffrence
End Sub


Private Sub LoadCards()
Dim pstrCards As String
Dim pstrSuits As String
Dim pstrCardArray() As String
Dim pstrSuitArray() As String
Dim i As Integer
Dim x As Integer
x = 1

  pstrCards = ",Ace,Two,Three,Four,Five,Six,Seven,Eight,Nine,Ten,Jack,Queen,King"
  pstrCardArray = Split(pstrCards, ",")
  pstrSuits = ",Hearts,Clubs,Diamonds,Spades"
  pstrSuitArray = Split(pstrSuits, ",")
'initialize progrss bar
progressbar1.value=0
progressbar1.min=0
progressbar1.max=65    ' x * i = 13 * 5
Do While Not x = 5
   For i = 1 To 13
       mstrCards(i).Card = pstrCardArray(i)
       mstrCards(x).Suit = pstrSuitArray(x)
       Debug.Print mstrCards(i).Card
       Debug.Print mstrCards(x).Suit
       progressbar1.value=progressbar1.value + 1'update bar
   Next
x = x + 1
Loop
End Sub
0
 
LVL 18

Expert Comment

by:mdougan
ID: 7180661
Here is a technique that I use to shuffle that I find gives a good random order:

pstrCards = ",Ace,Two,Three,Four,Five,Six,Seven,Eight,Nine,Ten,Jack,Queen,King"
 pstrCardArray = Split(pstrCards, ",")
 pstrSuits = ",Hearts,Clubs,Diamonds,Spades"
 pstrSuitArray = Split(pstrSuits, ",")

J = 1
Do While Not x = 5
  For i = 1 To 13
      mstrCards(j).Card = pstrCardArray(i)
      mstrCards(j).Suit = pstrSuitArray(x)
      j = j + 1
  Next
x = x + 1
Loop

Dim cCards as collection
Dim aDeck(1 to 52) as Long

' just get a list of the 52 numbers
For i = 1 to 52
   cCards.AddItem i
Next i

'Int(([upperbound] - [lowerbound] + 1) * Rnd + [lowerbound])

i = 1
Do While cCards.Count > 0
' select a collection's index randomly from the number of collection entries left in the list
   index = Int((cCards.Count - 1) + 1 * Rnd + 1)
' take the value in the collection at this index and move to the deck
   aDeck(i) = cCards(index)
' now remove that card number from the collection
   cCards.RemoveItem(index)
   i = i + 1
Loop
 
Then, you can simply iterate through the aDeck array, from 1 to 52 to retrieve the cards, which will be in random order:

debug.print mstrCards(aDeck(1)).Card, mstrCards(aDeck(1)).Suit
debug.print mstrCards(aDeck(2)).Card, mstrCards(aDeck(2)).Suit
debug.print mstrCards(aDeck(3)).Card, mstrCards(aDeck(3)).Suit
debug.print mstrCards(aDeck(4)).Card, mstrCards(aDeck(4)).Suit
debug.print mstrCards(aDeck(5)).Card, mstrCards(aDeck(5)).Suit

0
 

Author Comment

by:hollstar
ID: 7181660
I would rather not use a Timer event if possible... Still need to handle the progress and slider bars...

And that text box with the up and down arrows to increase its number by 1000 each time... Thats the only thing I need on this...

Sorry if I was not clear before... :(
0
 

Author Comment

by:hollstar
ID: 7190098
Just wanted to know how it has been going guys ?
0
 
LVL 18

Expert Comment

by:mdougan
ID: 7190630
Sorry hollstar, I guess it's still not clear what you have and what you still need.  Selim007 gave you code for updating the progress bar.  If by textbox with updown arrows you mean that you have a textbox and a spinner control next to it, then the code for changing the value in the textbox goes in the spinup and spindown events of the spinner control, and that code would just be:

'In SpinUp
text1.Text = CInt(text1.Text) + 1000

In SpinDown
text1.Text = CInt(text1.Text) - 1000

Of course, you'd have to make sure that the text in the textbox started out as some number.

You have to take a look at which controls you are using, and be specific with us, as we're just guessing.  If you are not sure, click on the control to highlight it, then click F4 to bring up the property box, and look at what it says next to the control's name in the drop-down list.  For text1 the combo would have:

Text1  textbox

So, tell us if you are using a scrollbar, or a spinner button or what, and then what you want to do with it.
0
 

Author Comment

by:hollstar
ID: 7208190
Sorry Guys... Been busy and had not had a chance to get back here... Been working on this on and off, and I think I found 'Gunsen' and his answer to be the best for me.

For this reason I will accept his comment. Should anyone else feel they should get points, let both myself and EE know... ;-)
0
 

Author Comment

by:hollstar
ID: 7208193
Overall not to bad - The reason I said 'B' was not really due to the code, but due to the fact you missed parts of my question. While I learned in the process, I did feel you did not really fully answer my question at the time...

If I could say 'A' for code I would... Top Stuff... :-)
0
 
LVL 3

Expert Comment

by:Gunsen
ID: 7208480
Thanx, hollstar.
0
 

Author Comment

by:hollstar
ID: 7208498
No Worries... :-) I think I did change something in your code, but I did have the skills (while very basic lol) to make it work for me...

Overall, I was happy with the outcome... Just took a while mainly because of me... Sorry for that once again...

Hollstar...
0

Featured Post

Free Tool: Subnet Calculator

The subnet calculator helps you design networks by taking an IP address and network mask and returning information such as network, broadcast address, and host range.

One of a set of tools we're offering as a way of saying thank you for being a part of the community.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

Introduction While answering a recent question about filtering a custom class collection, I realized that this could be accomplished with very little code by using the ScriptControl (SC) library.  This article will introduce you to the SC library a…
When trying to find the cause of a problem in VBA or VB6 it's often valuable to know what procedures were executed prior to the error. You can use the Call Stack for that but it is often inadequate because it may show procedures you aren't intereste…
As developers, we are not limited to the functions provided by the VBA language. In addition, we can call the functions that are part of the Windows operating system. These functions are part of the Windows API (Application Programming Interface). U…
Get people started with the utilization of class modules. Class modules can be a powerful tool in Microsoft Access. They allow you to create self-contained objects that encapsulate functionality. They can easily hide the complexity of a process from…

809 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question