[RESOLVED] Randomize forms in VB6

I originally was given 10 forms, each with 4 songs, to be played in random order (no repeats) and decided, for time and sanity sake to duplicate the forms. Now I have 40 forms to be presented randomly. The challenge for me is the first time the forms are called, they come from one location, the remaining 39 times come from another location.
On a recommendation, I used

Code:

---

Private Sub cmdNext_Click()
Dim adu As String
adu = Rand(1, 40)
Select Case adu
Case 1
frm1.Show
Case 2
frm2.Show
Case 3
frm2.Show
Case 4
frm4.Show
etc..
Case 40
frm40.Show

---

with the Rand function. However, I am getting duplicates (obviously) and wonder if anyone can offer a better option or modification I can make. I am not a programmer by trade, just by necessity. Would it be better to use flags?

wow, to start, there HAS to be a better way to go about that.

However, addressing the immediate question: I assume you want a random to pop up, but you dont want it to come back up untill all the others have? (not REALLY random, but I gotcha)

flags on each form could work, but then the form would have to stay loaded to read its flag to see if has been used yet.

without a redesign, I'd suggest having a 2d array. First column to track the forms, 2nd to flag whether it has been loaded or not. Then just keep calling rnd until you get one that has not been used.
If you want to re-loop the list though (when all forms have been used) make sure you track how many forms are used, so you can wipe all the flags when usedCount = formCount

I'm sure there will be other suggestions, and YES to you other guys, I know this isn't the best solution I'm offering. But it comes down to how much re-build do you want to do, to get it as short and sweet as possible?

Quote:

---

Originally Posted by Golgo1

wow, to start, there HAS to be a better way to go about that.


If you want to re-loop the list though (when all forms have been used) make sure you track how many forms are used, so you can wipe all the flags when usedCount = formCount

---

I have no doubt there's a better way and am beyond open to help. I don't need any to loop back through. It's the one-and-done philosophy. This will be a test for children to determine the format of the same phrase (done 4 different ways). If it's better to do two arrays: one with 10 forms, and one with 4 songs per form, I'm game. A redesign at this point is still an option. Thanks!

In terms of randomization, what you are trying to do is called random selection without replacement. This basically means you are trying to do the equivalent of putting 40 numbers into a hat and pulling them out WITHOUT replacing them.

There are several ways to implement this. One of the easiest ways is to treat the 40 numbers like a deck of cards and just shuffle them before dealing them out. To do that, place the 40 numbers in an array. Then iterate through the array. At each step, choose a random number. Then swap the numbers in the two locations. Each iteration is basically a single shuffle. If you iterate through the array several times, you should get a well randomized deck:

Code:

---

Private Sub cmdNext_Click()

Dim arrValues(40) As Long
Dim i As Long
Dim j As Long
Dim k As Long
Dim lngTemp As Long

'seed the array with numbers 1 - 40
For i = 1 To 40
  arrValues(i) = i
Next i

'shuffle it 7 times
For i = 1 To 7
  'iterate through the deck
  For j = 1 To 40
      'get random location to swap with
      k = Rand(1, 40)

      'swap the values
      lngTemp = arrValues(j)
      arrValues(j) = arrValues(k)
      arrValues(k) = lngTemp
  Next j
Next i

For i = 1 To 40
  Select Case arrValues(i)
      Case 1
        frm1.Show
      Case 2
        frm2.Show
      Case 3
        frm2.Show
      Case 4
        frm4.Show
etc..
      Case 40
        frm40.Show
.
.
.

---

Note... this only gets you a random list. Reorganizing your forms is another matter entirely. Good luck

I'm not sure what the forms do or how they are designed, but if they are all nearly identical, with the exception of the song, you could use 1 form with 40 songs. Or more 1 form, with 1 song, and change the song as needed. Of course, this may not be viable if the forms are designed differently for asthetics and such.

Assuming your forms are all designed and working, let's not break those up.
For the 2darray, you could declare a global variant array in your controlling Form/Module
Dim FormList(40,2)
You do still need a large chunk of code, but it's only on your first load
Set FormList(1,1) = frm1
Set FormList(2,1) = frm2
Set FormList(3,1) = frm3
etc....

then in your event

Code:

---

Private Sub cmdNext_Click()
Dim adu As String
adu = Rand(1, 40)
do while adu > 0
    if FormList(adu,2) <> 1 then      'check if form already flagged
        FormList(adu,1).show
        FormList(adu,2) = 1
        adu = -1
    end if
loop

---

This is a start, Im sure you'll customize it for what you need.

Other points: Make sure you properly Unload the forms when they are done thier turn.
Ensure your rand is returning proper values. <0 will not load anything, value higher than form count will cause error.
Using the indexes I specified leaves the 0 column and row empty. It simplifies things for you, but be aware of it if you plan to do more with the project later.

oop, leng got in as I was writing :p
his way would also be good. I was just trying to keep it simple :)
If you feel confortable with his way, it would probably use less memory.
However, if you feel like you want to keep track of other things the forms do (number of times loaded, number of correct responses, etc) the array can track that all without much change. And the big chunk (listing 40 forms) only runs once (instead of select case, checks all 40 every time)

Depends what works best for you. :afrog:

Quote:

---

Originally Posted by Golgo1

oop, leng got in as I was writing :p
his way would also be good. I was just trying to keep it simple :)
If you feel confortable with his way, it would probably use less memory.
However, if you feel like you want to keep track of other things the forms do (number of times loaded, number of correct responses, etc) the array can track that all without much change. And the big chunk (listing 40 forms) only runs once (instead of select case, checks all 40 every time)

Depends what works best for you. :afrog:

---

Thanks for your help thus far!
Not to sound daft, but..I am trying your method and have listed the forms in the module but have not declared the FormList as a global variable. What type would it be? It's not a string ('Object Variable or With block variable not set') and when I tried variant got an error message of 'Type Mismatch.' :confused:

hmmm
Dim FormList(40,2) as Variant
Where you declare it will depend what scope you want it to be. I doubt there would be anything wrong in this case with making it module level.

where does it give you type mismatch?
also, when assigning objects (like forms) remember to use SET.

Quote:

---

Originally Posted by Golgo1

hmmm
Dim FormList(40,2) as Variant
Where you declare it will depend what scope you want it to be. I doubt there would be anything wrong in this case with making it module level.

where does it give you type mismatch?
also, when assigning objects (like forms) remember to use SET.

---

I think I got it to work, but I failed to save and it froze and had to be closed
*smacks hand against forehead* I will let you know if it continues to work or if there are problems.
Thank you

How can I run the If to make it load another form when all of them have shown? I tried an Else If, but if adu=-1 then (adu,2) will never be true.

If all forms have been shown, and you want to basicly 'reset' them and continue with another run through, I'd use something like:

Code:

---

Private Sub cmdNext_Click()
Dim adu As String
adu = Rand(1, 40)

if FormsFlagged >= 40 then
      RemoveFlags
end if
do while adu > 0
    if FormList(adu,2) <> 1 then      'check if form already flagged
        FormList(adu,1).show
        FormList(adu,2) = 1
        FormsFlagged = FormsFlagged +1
        adu = -1
    end if
loop

private sub RemoveFlags()
dim I as int
for i = 0 to 40
  FormList(adu,2) = 0
next i
end sub

---

You dont HAVE to make the loop a seperate procedure, but you might want it elsewhere.
You may also want to make a constant like NUM_FORMS, that way you only have to declare 40 once. If you add or remove forms in the future, it will make things ALOT easier.
And final suggestion, depending on the project, I like to set the option to Auto Save Project before running, that way if it crashes I still have my work (unless I change code at runtime)

also just realized something, we left the FormList(0,0) empty.
I often keep index 0 for just such an occasion.... if you don't want to declare a new variable, you can just use FormList(0,0) to store your form counter.
ie.

Code:

---

FormList(0,0) = FormList(0,0) +1

---

and also, dont forget to reset that value when you reset the array (I forgot to include it in previous post)
FormList(0,0) = 0

Quote:

---

Originally Posted by Lenggries

In terms of randomization, what you are trying to do is called random selection without replacement. This basically means you are trying to do the equivalent of putting 40 numbers into a hat and pulling them out WITHOUT replacing them.

---

Exactly. Thank you for the correct term. I really have been trying to figure out what it's called. I've been referencing it as a pseudo-random.

Quote:

---

Code:

---

Private Sub cmdNext_Click()

Dim arrValues(40) As Long
Dim i As Long
Dim j As Long
Dim k As Long
Dim lngTemp As Long

'seed the array with numbers 1 - 40
For i = 1 To 40
  arrValues(i) = i
Next i

'shuffle it 7 times
For i = 1 To 7
  'iterate through the deck
  For j = 1 To 40
      'get random location to swap with
      k = Rand(1, 40)

      'swap the values
      lngTemp = arrValues(j)
      arrValues(j) = arrValues(k)
      arrValues(k) = lngTemp
  Next j
Next i

For i = 1 To 40
  Select Case arrValues(i)
      Case 1
        frm1.Show
      Case 2
        frm2.Show
      Case 3
        frm2.Show
      Case 4
        frm4.Show
etc..
      Case 40
        frm40.Show

---

Note... this only gets you a random list. Reorganizing your forms is another matter entirely. Good luck

---

That works perfectly! Thank you. Now, this probably what you meant in your last sentence, but is there a command or block of code to only have one appear at a time? If I run it now, I get 41 screens and then it freezes and I have to force quit.

Quote:

---

Originally Posted by Lenggries

One of the easiest ways is to treat the 40 numbers like a deck of cards and just shuffle them before dealing them out. To do that, place the 40 numbers in an array. Then iterate through the array. At each step, choose a random number. Then swap the numbers in the two locations. Each iteration is basically a single shuffle. If you iterate through the array several times, you should get a well randomized deck:

---

There is no need to shuffle more than once. Also, your shuffling algorithm is biased in that it picks a random item from the entire list each time. It should only pick a random item from the remaining unshuffled part, including the current item. For example, in a group of 4 items:

Item 1 is exchanged with item 1, 2, 3 or 4
Item 2 is exchanged with item 2, 3 or 4
Item 3 is exchanged with item 3 or 4

Deviating from this exact algorithm in any way adds bias to your shuffling algorithm. Here is an unbiased shuffling algorithm for any one-dimensional array (excluding udt arrays):

vb Code:

' Knuth shuffle (very fast)
Public Sub ShuffleArray(pvarArray As Variant)
    Dim i As Long
    Dim iMin As Long
    Dim iMax As Long
    Dim lngReplace As Long
    Dim varSwap As Variant
    
    iMin = LBound(pvarArray)
    iMax = UBound(pvarArray)
    For i = iMax To iMin + 1 Step -1
        lngReplace = Int((i - iMin + 1) * Rnd + iMin)
        varSwap = pvarArray(i)
        pvarArray(i) = pvarArray(lngReplace)
        pvarArray(lngReplace) = varSwap
    Next
End Sub

For the curious, wikipedia explains the bias in selecting from the entire range each time instead of the remaining range (including current item):

Quote:

---

Similarly, always selecting k from the entire range of valid array indexes on every iteration also produces a result which is biased, albeit less obviously so. This can be seen from the fact that doing so yields NN distinct possible sequences of swaps, whereas there are only N! possible permutations of an N-element array. Since NN can never be evenly divisible by N! (as the latter is divisible by N−1, which shares no prime factors with N when N > 2), some permutations must be produced by more of the NN sequences of swaps than others.

As a concrete example of this bias, observe the distribution of possible outcomes of shuffling a three-element array [1, 2, 3]. There are 6 possible permutations of this array (3! = 6), but the algorithm produces 27 possible shuffles (33 = 27). In this case, [1, 2, 3], [3, 1, 2], and [3, 2, 1] each result from 4 of the 27 shuffles, while each of the remaining 3 permutations occurs in 5 of the 27 shuffles.

---

The other common mistake is to not include the current item in the range of positions to swap with. The bias in that error is obvious: The first item can never end up in the first position.

Quote:

---

Originally Posted by Ellis Dee

Deviating from this exact algorithm in any way adds bias to your shuffling algorithm. Here is an unbiased shuffling algorithm for any one-dimensional array (excluding udt arrays):

vb Code:

' Knuth shuffle (very fast)
Public Sub ShuffleArray(pvarArray As Variant)
    Dim i As Long
    Dim iMin As Long
    Dim iMax As Long
    Dim lngReplace As Long
    Dim varSwap As Variant
    
    iMin = LBound(pvarArray)
    iMax = UBound(pvarArray)
    For i = iMax To iMin + 1 Step -1
        lngReplace = Int((i - iMin + 1) * Rnd + iMin)
        varSwap = pvarArray(i)
        pvarArray(i) = pvarArray(lngReplace)
        pvarArray(lngReplace) = varSwap
    Next
End Sub

---

Where would I put this on the form? What I decided to do was use one of the 40 on the first form that leads to the answer form, that will randomize, so I have 39 instead. Do I put this just as its own statement (which I am assuming is correct)? If so. what command would I list for the cmdNext? Thank you

Quote:

---

Originally Posted by vdriscoll

Now, this probably what you meant in your last sentence, but is there a command or block of code to only have one appear at a time? If I run it now, I get 41 screens and then it freezes and I have to force quit.

---

vbModal is what you want. To show your forms I would go with somthing like this. There is no need for a select case

Code:

---

Dim frm As Form
Dim i As Integer

    For i = 1 To 40
        Set frm = Forms.Add("frm" & i)
        frm.Show vbModal
    Next i

---

Quote:

---

Originally Posted by MarkT

vbModal is what you want. To show your forms I would go with somthing like this. There is no need for a select case

Code:

---

Dim frm As Form
Dim i As Integer

    For i = 1 To 40
        Set frm = Forms.Add("frm" & i)
        frm.Show vbModal
    Next i

---

---

Okay, so how do I make this work? I really want to understand, but I'm not sure where to replace the code and what to then remove. I apologize for my lack of knowledge but I'm working to improve it.

Quote:

---

Originally Posted by Ellis Dee

For the curious, wikipedia explains the bias in selecting from the entire range each time instead of the remaining range (including current item)

---

Interesting stuff. Thanks for the heads up.

Here is the complete code that I would use. I personally prefer using a collection to shuffle but an array could be used instead. This assume that you do have forms in you project name frm1 through frm40. If you don't you will generate an error.

Code:

---

Option Explicit

Private Sub Command1_Click()
Dim frm As Form
Dim i As Integer
Dim arr() As Integer
Dim intNumberOfForms As Integer

    intNumberOfForms = 40

    arr = Shuffle(intNumberOfForms - 1)
   
    For i = 0 To intNumberOfForms - 1
        Set frm = Forms.Add("frm" & arr(i))
        frm.Show vbModal
        Set frm = Nothing
    Next i

End Sub

Private Function Shuffle(ByVal intSize As Integer) As Integer()
Dim col As Collection
Dim i As Integer
Dim arrValues() As Integer

    'Set the array size
    ReDim arrValues(intSize)

    'Create a collection
    Set col = New Collection
    'Add all possible values to the collection
    For i = 0 To intSize
        col.Add (i + 1), CStr(i + 1)
    Next i
   
    'Make sure you randomize the results
    Randomize
   
    'Loop through the collection until we have used all the values
    Do While col.Count > 0
        'Get a random item from the collection
        i = Int(Rnd() * col.Count)
        'Save the collection items value into the array
        arrValues(col.Count - 1) = col.Item(i + 1)
        'Remove the collection item so it isn't reused
        col.Remove i + 1
    Loop
   
    'Return the array
    Shuffle = arrValues

    'Free resources
    Set col = Nothing
End Function

---

Quote:

---

Originally Posted by MarkT

Code:

---

Option Explicit

Private Sub Command1_Click()
Dim frm As Form
Dim i As Integer
Dim arr() As Integer
Dim intNumberOfForms As Integer

    intNumberOfForms = 40

    arr = Shuffle(intNumberOfForms - 1)
   
    For i = 0 To intNumberOfForms - 1
        Set frm = Forms.Add("frm" & arr(i))
        frm.Show vbModal
        Set frm = Nothing
    Next i

End Sub

Private Function Shuffle(ByVal intSize As Integer) As Integer()
Dim col As Collection
Dim i As Integer
Dim arrValues() As Integer

    'Set the array size
    ReDim arrValues(intSize)

    'Create a collection
    Set col = New Collection
    'Add all possible values to the collection
    For i = 0 To intSize
        col.Add (i + 1), CStr(i + 1)
    Next i
   
    'Make sure you randomize the results
    Randomize
   
    'Loop through the collection until we have used all the values
    Do While col.Count > 0
        'Get a random item from the collection
        i = Int(Rnd() * col.Count)
        'Save the collection items value into the array
        arrValues(col.Count - 1) = col.Item(i + 1)
        'Remove the collection item so it isn't reused
        col.Remove i + 1
    Loop
   
    'Return the array
    Shuffle = arrValues

    'Free resources
    Set col = Nothing
End Function

---

---

Thank you, MarkT. I went through and renamed my forms to fit the code.I do, however, want to progress to a final screen upon completion of the 40 randomization. Not wanting to mess up you beautiful code, where would it go?

Call your final form after this part of the code

Code:

---

    For i = 0 To intNumberOfForms - 1
        Set frm = Forms.Add("frm" & arr(i))
        frm.Show vbModal
        Set frm = Nothing
    Next i

---

Quote:

---

Originally Posted by MarkT

Call your final form after this part of the code

Code:

---

    For i = 0 To intNumberOfForms - 1
        Set frm = Forms.Add("frm" & arr(i))
        frm.Show vbModal
        Set frm = Nothing
    Next i

---

---

Wonderful. Thank you!! If I could I'd send you a cookie (or several)!

hhe, hello!! Good day!
Can I ask a favor for the software that I am making?

please help me, hhe,
I have 10 forms to run randomly , the names of each form is from
Easy1, Easy2……………………Easy10
And this randomnation will start when I click the start button,

well considerably, I really have to have 30 forms for the software, and the 10 forms that I am asking here with you all guys, is the forms that will run when I click the easy button to execute the easy forms to start the quiz, the other 20 forms is divided on the 2 buttons which is the “Normal”, and the “Hard”, hhe, I also have another button that will run all of the 30 forms with its name of “Play ALL”, and what I need is the code for all of it,
I need them all to execute and run randomly, without repetition,
and on every forms or questions, it haves 3 lives that when I clciked the wrong button, it will less to the 3 lives until it gets to zero and open the Game Over button, that will again start at the beginning.

here is one of the form, I have
Attachment 97309
And the code
Attachment 97311
ublic Class Quiz1a
Const QuestionCount As Integer = 10
Private Sub Button1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button1.Click
Dim QuestionList As List(Of Integer) = GenerateUnique(QuestionCount, 1, QuestionCount)

For Each x As Integer In QuestionList
Dim frm As Form = DirectCast(Activator.CreateInstance(Type.GetType(S tring.Format("{0}.{1}{2}", "software", "Easy", x))), Form)
frm.ShowDialog()


Next
End Sub
Private Shared Function GenerateUnique(ByVal LoopCount As Integer, ByVal rMin As Integer, ByVal rMax As Integer) As List(Of Integer)
Dim holder As New HashSet(Of Integer)
Dim rand As New Random
Do
holder.Add(rand.Next(rMin, rMax + 1))
Loop Until holder.Count = 10
Return holder.ToList
End Function
End Class



Public Class Easy1
Public Count As Integer
Private Sub Button3_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button3.Click
Me.Close()
score += 5
End Sub
Private Sub Button2_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button2.Click
Count -= 1
Label2.Text = Str(Count)
Easy2.Label2.Text = Label2.Visible
Easy3.Label2.Text = Label2.Text
Easy4.Label2.Text = Label2.Text
Easy5.Label2.Text = Label2.Text
Easy6.Label2.Text = Label2.Text
Easy8.Label2.Text = Label2.Text
Easy7.Label2.Text = Label2.Text
Easy9.Label2.Text = Label2.Text
Easy10.Label2.Text = Label2.Text
If Label2.Text = 0 Then
GameOver.ShowDialog()
Me.Close()
End If
End
End Sub

Private Sub Button4_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button4.Click
Count -= 1
Label2.Text = Str(Count)
Easy2.Label2.Text = Label2.Visible
Easy3.Label2.Text = Label2.Text
Easy4.Label2.Text = Label2.Text
Easy5.Label2.Text = Label2.Text
Easy6.Label2.Text = Label2.Text
Easy8.Label2.Text = Label2.Text
Easy7.Label2.Text = Label2.Text
Easy9.Label2.Text = Label2.Text
Easy10.Label2.Text = Label2.Text
If Label2.Text = 0 Then
GameOver.ShowDialog()
Me.Close()
End If
End Sub

Private Sub Easy1_Load_1(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load
Count = Label2.Text
End Sub

Private Sub Button1_Click_1(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button1.Click
Count -= 1
Label2.Text = Str(Count)
Easy2.Label2.Text = Label2.Visible
Easy3.Label2.Text = Label2.Text
Easy4.Label2.Text = Label2.Text
Easy5.Label2.Text = Label2.Text
Easy6.Label2.Text = Label2.Text
Easy8.Label2.Text = Label2.Text
Easy7.Label2.Text = Label2.Text
Easy9.Label2.Text = Label2.Text
Easy10.Label2.Text = Label2.Text
If Label2.Text = 0 Then
GameOver.ShowDialog()
Me.Close()
End If
End Sub
End Class

@ cyrilkun

You should start a new thread for your question rather than piggy back unto someone elses question, especially in this case since you are using VB.Net and the Thread is on VB6. Your question belongs in the Vb.Net area.

You are also not as likely to get help when you ask for the code for all of it but rather when you ask specific questions about problems you are having. We are here to help you help yourself not to write code for you.